perm filename TEXSEM.SAI[TEX,DEK] blob
sn#606858 filedate 1981-08-09 generic text, type C, neo UTF8
COMMENT ⊗ VALID 00019 PAGES
C REC PAGE DESCRIPTION
C00001 00001
C00004 00002 entry begin comment The semantics module of TEX.
C00008 00003 Data structures for boxes.
C00027 00004 Displaying and destroying boxes: dumpnodelist,dsnodelist,tracedump,boxcopy
C00037 00005 The semantic stacks: mode,head,curnode,aux,spacefactor,prevdepth,incompleat
C00044 00006 The page builder.
C00054 00007 Introduction to math formula processing and data structures for mlists.
C00076 00008 Maintaining the semantic stacks: pushnest,popnest,decodemode,dumpactivities
C00080 00009 Font information. (New specifications due to Lyle Ramshaw, November 1980.)
C00116 00010 Making lists into boxes: nullbox,hpackage,vpackage,hpack,vpack
C00130 00011 Spacing and adding to the current list: initsftable,append,finishdisplay
C00141 00012 Hyphenation (word division) routines.
C00160 00013 The paragraph builder: hangwidth,hangbegin,justification,finishparagraph
C00201 00014 Procedures for mmode: finishmlist,boxchar,compact,mathglue,varsymbol,
C00218 00015 Major math mode procedures: mlist_to_hlist,evalmlist,boxfield
C00253 00016 Data structures for \halign and \valign: alignlist,alignrecord
C00260 00017 Alignment procedures: (init|end)align,(start|finish)(alignbox|unsetnode)
C00275 00018 Beginning of the main procedure: maincontrol
C00323 00019 Ending of the main procedure
C00350 ENDMK
C⊗;
entry; begin comment The semantics module of TEX.
(It is wise to read the introductory pages of TEXSYN before going very
deeply into the following code.)
The purpose of these routines is to consume the tokens supplied by
the syntax module of TEX, and to produce the data structures for boxes
that are periodically shipped to the output module.
Like the syntax module, the semantics process is implicitly recursive,
but the large procedures themselves are coded here in a nonrecursive
way so that the common features are shared and so that the
algorithms are easily expressible in low-level languages. In other
words, this module has a bunch of stacks too.
Just as the syntax scanning routines are said to be in various "states"
(e.g., middle of an input line, or skipping blanks or reading token lists),
the semantics routines are said to be in various "modes" (e.g., horizontal
mode, or verticl mode or math mode). There is a modestack for keeping track
of the modes in partially completed activities.
These routines call getnext or other scanning routines of TEXSYN in order
to get input tokens. They call sendout to invoke the output module when
a completed page has been built.
Some short routines in this module are explicitly recursive. For example, the
routine that prints the contents of a box uses itself, since boxes can
be inside boxes;
require "TEXHDR.SAI" source_file;
internal saf integer array mem[0:memsize] # dynamic list memory;
comment Data structures for boxes.
What follows is a description of the semantic data structures that
serve as interface between TEXSEM and the output module. A user of TEX
deals with boxes and with hlists and vlists built up by gluing these
boxes together with flexible glue. TEX's internal representation
follows these concepts quite closely.
The storage is allocated in variable-length nodes from the mem array,
as explained in TEXSYS. The first word of each node contains a type
field, a value field, and a link field. The type field tells what
kind of node this is, the value field contains additional information
depending on the type, and the link field is used to tie nodes together
into hlists or vlists.
;
internaldef types=5, typed=bitsperwd-types # definition of type field;
internaldef values=typed-links, valued=links # definition of value field;
comment values must be ≥ links;
internaldef type(p)=⊂field(type,mem[p])⊃ # shorthand for type field;
internaldef value(p)=⊂field(value,mem[p])⊃ # shorthand for value field;
comment Since the type of a node never exceeds 4 bits, the definition types=5
guarantees that the first word of a multiple-word node is ≥0, in accordance
with our memory allocation conventions. (On a machine with shorter word size
it would be possible to make the type field smaller, by (a) using the fact
that one-word nodes may be negative, or (b) combining types and differen-
tiating them on the basis of other fields.)
A box is either a single character, or a rule, or a vlist or hlist with
specified glue setting and relocation. Each box has three dimensions
height, depth, width
associated with it, as shown:
----------------- ∧
| | |
| | |
| | height
| | |
| | |
reference point--→*---baseline----| x
| | |
| | depth
| | |
----------------- ∨
<-----width----->
All dimensions are real values in units of points.
Type 0 node: A single character. One word long.
The value is subdivided into a font selector and a 7-bit
character code. Dimensions of such boxes are derived from
the font description, as explained later;
internaldef charnode=0 # type code for a character box;
comment
Type 1 or 2 node: A box consisting of an hlist or vlist with glue set.
Six words long. The value points to the first element of the list in question.
All three box dimensions are explicitly given, as is the glueset parameter
that weights how much stretching or shrinking is to be done. (Namely, all
glue nodes in the hlist or vlist are to have their gluespace increased by
glueset*gluestretch, if glueset≥0, otherwise by glueset*glueshrink.)
A further parameter tells how much to shift this box downwards or to the right,
depending on whether this box itself appears in an hlist or vlist, respectively;
internaldef hlistnode=1 # type code for a box made from an hlist;
internaldef vlistnode=2 # type code for a box made from a vlist;
internaldef boxnodesize=6 # number of words to allocate for a box node;
internaldef width(p)=⊂memreal(p+1)⊃ # width field in nodes;
internaldef depth(p)=⊂memreal(p+2)⊃ # depth field in nodes;
internaldef height(p)=⊂memreal(p+3)⊃ # height field in nodes;
internaldef shiftamt(p)=⊂memreal(p+4)⊃ # amount to shift this box;
internaldef glueset(p)=⊂memreal(p+5)⊃ # glueset field in box nodes;
comment The stated height, width, and depth of a box might not be equal to
the box's "true" height, width, or depth that would be determined from
the list in the box. Therefore we must give further clarification in order
to define the position of each box unambiguously. Here are the rules:
In a vlist box whose upper left corner is in column x and row y, the
first box in that vlist has the upper left corner, the next box
has upper left corner in column x and row y-h-d (where h and d are the
height and depth of the first box), and so on.
In an hlist box whose reference point is in column x and row y, the
first box in that hlist has the same reference point, the next box
has reference point in column x+w and row y (where w is the width
of the first box), and so on.
Glue nodes are treated in this rule as if they were boxes having an appropriate
height+depth (in a vlist) or an appropriate width (in a vlist).
Note that the rule is stated in terms of upper left corners in vlists,
but in terms of reference points in hlists.
One consequence: If V is a vlist box in an hlist, changing
height(V)←height(V)+delta, depth(V)←depth(V)-delta
would be exactly equivalent to changing
shiftamt(V)←shiftamt(V)+delta.
But if V were a vlist box in a vlist, or an hlist box in an hlist, the
stated change to V's height and depth would have no effect whatever. And if
V were an hlist box in a vlist, the stated change would lower the contents
of V by an amount delta (this is something you couldn't do by changing shiftamt(V)).
Is that clear?
When a box does not have its "true" dimensions as determined by the sublist,
its glueset parameter will be nonzero. At least, this is true for boxes that
can appear in math formulas.
Type 3 node: A rule (solid black rectangle). Four words long, containing
height, depth, and width as in box nodes. If any of the three dimensions
is ≤-100000.0, its actual value is determined by running the rule
up to the boundary of the innermost enclosing box. The width is never
negative in an hlist, the height and depth are never negative in a vlist;
internaldef rulenode=3 # type code for a "black box";
internaldef rulenodesize=4 # number of words to allocate for it;
comment
Type 4 node: Reserved for extensions. Such nodes should only be inserted by
routines in the TEXEXT module. For example, there might be an extension to
draw vectors, and this node might contain the desired coordinates;
internaldef whatsitnode=4 # type code for special nodes used by extensions;
comment
Type 5 node: Glue. One word long. The value field points to a four-word
glue node, consisting of a reference count followed by the spacing,
streching, and shrinking parameters of the glue;
internaldef gluenode=5 # type code for a node that points to glue specification;
internaldef gluespecsize=4 # number of words allocated in glue specifications;
internaldef gluespace(p)=⊂memreal(p+1)⊃ # normal spacing of glue;
internaldef gluestretch(p)=⊂memreal(p+2)⊃ # stretching factor of glue;
internaldef glueshrink(p)=⊂memreal(p+3)⊃ # shrinking factor of glue;
define fillgluespec=(gluenode lsh typed)+(fillglue lsh valued) # specifies fillglue;
define lowerfillgluespec=(gluenode lsh typed)+(lowerfillglue lsh valued);
comment
Type 6 node: Leaders. One word long. The value field points to a rule node or to
a box node. In the second case, the shiftamt field of the box node is zero,
positive, or negative, corresponding to \leaders, \xleaders, or \cleaders. In
either case the next item in the current list should be a glue node that specifies
the intended length of the leaders;
internaldef leadernode=6 # type code for leaders node;
comment
Type 7 node: Kerning. Two words long, meaningful only in hlists. The "gluespace"
field specifies a (normally negative) amount of glue, used in spacing between
letters like A and V when it looks better to move them closer together;
internaldef kernnode=7 # type code for kerning node;
internaldef kernnodesize=2 # number of words in kern node;
comment The following types of nodes should be ignored by the output module
since they are meaningful only temporarily while hlists or vlists are
being built. It is easier to let the output routine ignore them than to
remove them from the lists.
Type 8 node: Hyphenation control. One word long, meaningful only in hlists.
If value=1, do not use automatic hyphenation in subsequent parts of the
current list until encountering a hyphenation control node with value=0.
Used to protect mathematical formulas;
define hyphnode=8 # type code for a hyphenation control node;
comment
Type 9 node: Penalty break. One word long. The value specifies how many
additional penalty points to charge if an hlist or vlist is broken at
this place, in two's complement notation (it might be negative);
define penaltynode=9 # type code for a penalty break node;
define penalty(p)=
⊂((mem[p]lsh(bitsperwd-values-valued))ash(-bitsperwd+values))⊃;
define infpen=⊂((1 lsh(values-1))-1)⊃ # "infinite" penalty;
comment
Type 10 node: Discretionary break node. One word long, meaningful only in
hlists. Contains font and character code like a character node. Specifies
that the hlist may be broken here, inserting the specified character
(usually - or x) with the hpen badness penalty for hyphenation. If the
specified character is 0, however, this represents a break after an explicit
hyphen or dash, with no character to be inserted and with the exhyph penalty
to be charged;
define discnode=10 # type code for discretionary break node;
comment
Type 11 node: Page eject node. One word long, meaningful only in vlists for
the page builder or hlists for the paragraph builder, specifies where to
break off and finish a page. The value field is 0 for linebreak, 1 for eject,
2 for pagebreak;
define ejectnode=11 # type code for page eject node;
comment
Type 12 node: Mark node. One word long, meaningful only in vlists for the
page builder. The value field points to the reference count of a tokenlist
corresponding to an identification mark in the text;
define marknode=12 # type code for mark node;
comment
Type 13 node: Insertion node. One word long, meaningful only in vlists for
the page builder or hlists for the paragraph builder. The value points
to a special node that describes a vlist to be inserted at the top or
bottom of a page. This special node has the form of a glue specification,
giving the characteristics of the space filled by the inserted list.
However, the first word of the special node is not a reference count,
it contains a pointer to the vlist in its value field and an indication of
top (1+d) or bottom (d) in its type field, where d = 0 or 2 or 4 according as the
insertion is in hmode (non-deferrable) or vmode (deferrable) or neither
(\topsep or \botsep). Furthermore there is an additional word that specifies
the depth of the insertion;
define insnode=13 # type code for insertion node;
internaldef insspecsize=5 # number of words allocated in insert specifications;
define insdepth(p)=⊂memreal(p+4)⊃ # depth of the vertical list;
comment
Type 14 node: Unset node. Same length as box nodes, meaningful only
while \halign or \valign is in progress. For halign, the width is the
natural width, and in valign the height is the natural height, while
the other two dimensions are equal to their true final values. The
glueset field of unset nodes is the total gluestretch in the
associated list pointed to in the value field. Unset nodes will be
changed into box nodes when alignment is completed;
define unsetnode=14 # type code for unset box node;
comment Links to completed boxes stored by the \save actions (\save0 thru \save9)
get put into savedbox["0"] thru savedbox["9"]. Links to completed boxes for
leaders get put into savedbox[":"]. A link to the current page, to be
called forth by the \page action, gets put into savedpage;
internal saf integer array savedbox["0":":"] # pointers to saved boxes;
integer savedpage # pointer to current page;
preload_with "","\hbox","\vbox","\rule","","\glue","\leaders",
"\kern","\hyphenation","\penalty","\discretionary","\eject","\mark","",
"\unsetbox"; saf string array nodeident[0:unsetnode] # names of node types;
comment Displaying and destroying boxes: dumpnodelist,dsnodelist,tracedump,boxcopy;
comment Tracing is governed by the global variable "tracing", which has the
octal form MMMNNNxy. Here MMM tells how many items per box to dump,
NNN specifies the maximum depth of nesting to be dumped, and x and y are further
three-bit codes that invoke tracing as follows:
x land 1 means trace macro calls
x land 2 means put file input on screen for possible online editing
x land 4 means stop whenever \ddt is scanned in the input
y land 1 means trace whenever getting a box that wants to shrink more
than the glue will allow
y land 2 means trace whenever getting a page to send to \output
y land 4 means trace whenever \ddt is scanned in the input.
The normal value of tracing is 0. If MMM=0, 5 items per box are dumped;
string simp procedure rfmt(real x) # output format used for rule dimensions;
return(if x>-100000.0 then cvf(x) else " *");
recursive procedure dumpnodelist(integer p; string indent; integer thresh,n);
begin comment This diagnostic routine displays the contents of a list of
nodes, each line of output being preceded by "indent", unless the length of
indent is more than thresh. (Thus, by setting thresh low you restrict the
output to top level boxes.) Furthermore, only n items per box are shown;
integer t,v,i,m,c;
if length(indent)>thresh then return;
c←0;
while p do
begin print(nextline,indent);
if p<0 or p≥memsize then
begin print("Bad link, dump aborted."); done;
end;
if (c←c+1)>n then
begin print("etc."); return;
end;
t←field(type,m←mem[p]);v←field(value,m);
if t>unsetnode then print("Unknown node type!")
else begin
print(nodeident[t]);
case t of begin
[charnode][discnode] begin print("\:");
if v<(("z"+1-"@")lsh 7) then print(""&("@"+(v lsh -7)))
else print(""&(v lsh -7));
v←v land '177;
if v>" " and v≤"z" then print(" "&v) else print(" '",cvos(v)) end;
[hlistnode][vlistnode][unsetnode] begin
print("(",cvf(height(p))," +",cvf(depth(p)),")x",cvf(width(p)));
if glueset(p) then print(", glueset",cvf(glueset(p)));
if shiftamt(p) then print(", shifted",cvf(shiftamt(p)));
dumpnodelist(v,indent&".",thresh,n); end;
[rulenode] print("(",rfmt(height(p))," +",rfmt(depth(p)),")x",
rfmt(width(p)));
[gluenode][insnode] if v<memsize then
begin if t=insnode then
begin if type(v) land 1 then print("\topinsert")
else print("\botinsert");
if type(v) land 4 then print(" (separator)")
else if type(v) land 2 then print(" (can wait)");
end;
print(cvf(gluespace(v)),
if gluestretch(v) then " plus"&cvf(gluestretch(v))else null,
if glueshrink(v) then " minus"&cvf(glueshrink(v))else null);
if t=insnode then
begin print(", depth ",cvf(insdepth(v)));
dumpnodelist(value(v),indent&".",thresh,n);
end;
end
else print(":Impossible spec!");
[whatsitnode] dumpext(p);
[leadernode] begin if type(v)≠rulenode then
begin t←shiftamt(v); shiftamt(v)←0;
if t>0 then print("(x)") else if t<0 then print("(c)");
end;
dumpnodelist(v,indent&".",thresh,n);
if type(v)≠rulenode then shiftamt(v)←t end;
[kernnode] print(cvf(gluespace(p)));
[hyphnode] print(v);
[penaltynode] print(penalty(p));
[ejectnode] print(v);
[marknode] print("{",dumptokens(link(v)),"}");
else comment this really can't happen;
end;
end;
p←link(p);
end;
end;
internal recursive procedure dsnodelist(integer p) # frees a list of boxes;
begin comment This procedure returns the list and its sublists to free storage;
integer t,v,i,m,q;
while p do
begin q←link(p);
case t←field(type,m←mem[p]) of begin
[charnode][hyphnode][penaltynode][discnode][ejectnode]
freeavail(p);
[leadernode] begin dsnodelist(field(value,m));freeavail(p);end;
[hlistnode][vlistnode] begin dsnodelist(field(value,m));
freenode(p,boxnodesize); end;
[rulenode] freenode(p,rulenodesize);
[gluenode] begin delgluelink(field(value,m)); freeavail(p) end;
[whatsitnode] destroyext(p);
[kernnode] freenode(p,kernnodesize);
[insnode] begin v←field(value,m); dsnodelist(value(v));
freenode(v,insspecsize); freeavail(p) end;
[marknode] begin delrclink(field(value,m)); freeavail(p) end;
else confusion
end;
p←q;
end;
end;
procedure tracedump(integer p) # calls dumpnodelist with tracing threshold;
dumpnodelist(p,null,(tracing lsh -6)land '777,
if tracing land (-'100000) then (tracing lsh-15)land '777 else 5);
recursive integer procedure boxcopy(integer p);
begin comment This routine copies a list of nodes (to implement \copy);
integer q,t,m,r,v,hd; label copy1,copy2,copy4,straightcopy,linkup;
getavail(hd); q←hd; mem[q]←0;
while p do
begin t←field(type,m←mem[p]);v←field(value,m);
case t of begin
[charnode][hyphnode][penaltynode][discnode][ejectnode] go to straightcopy;
[hlistnode][vlistnode][unsetnode] begin r←getnode(boxnodesize);
shiftamt(r)←shiftamt(p); glueset(r)←glueset(p); go to copy4 end;
[rulenode] begin r←getnode(rulenodesize); go to copy4 end;
[gluenode][marknode] begin mem[v]←mem[v]+refct1; go to straightcopy end;
[whatsitnode] begin r←copyext(p); go to linkup end;
[leadernode] begin getavail(r); go to copy1 end;
[kernnode] begin r←getnode(kernnodesize); go to copy2 end;
[insnode] begin m←getnode(insspecsize); getavail(r);
mem[r]←(insnode lsh typed)+(m lsh valued);
mem[m]←(mem[v]land(-1 lsh typed))+(boxcopy(field(value,mem[v]))lsh valued);
gluespace(m)←gluespace(v); gluestretch(m)←gluestretch(v);
glueshrink(m)←glueshrink(v); insdepth(m)←insdepth(v); go to linkup end;
else confusion
end;
copy4: mem[r+3]←mem[p+3]; mem[r+2]←mem[p+2];
copy2: mem[r+1]←mem[p+1];
copy1: mem[r]←(t lsh typed)+(boxcopy(v) lsh valued);
go to linkup;
straightcopy: getavail(r); mem[r]←mem[p] land (-1 lsh valued);
linkup: mem[q]←mem[q]+r; q←r; p←link(p);
end;
q←mem[hd]; freeavail(hd); return(q);
end;
comment The semantic stacks: mode,head,curnode,aux,spacefactor,prevdepth,incompleat;
comment The state of semantic processing appears in the following stacks,
maintained with "convention #1" (cf. the discussion of input stacks in TEXSYN);
internal integer nestptr # points to first unused in semantic stacks;
internaldef nestsize = 40 # max number of things going on simultaneously;
internal saf integer array modestack[0:nestsize-1]; internal integer mode
# current activity modes;
internal saf integer array headstack[0:nestsize-1]; internal integer head
# pointers to list heads for lists being constructed;
internal saf integer array curndstack[0:nestsize-1]; internal integer curnode
# pointers to nodes most recently added to the current lists;
internal saf real array auxstack[0:nestsize-1]; internal real aux;
# auxiliary parameter (either spacefactor or prevdepth or incompleatnoad);
internaldef prevdepth=⊂aux⊃, spacefactor=⊂aux⊃,
incompleatnoad=⊂memory[location(aux),integer]⊃;
comment At each level of processing we are in one of six modes:
vmode vertical mode (the page builder)
hmode horizontal mode (the paragraph builder)
mmode displayed formula mode
-vmode restricted vertical mode (not the page builder)
-hmode restricted horizontal mode (not the paragraph builder)
-mmode math formula mode (not displayed).
These modes are assigned internal codes so that it is easy to switch to the
appropriate action by branching on abs(mode)+curcmd;
internaldef vmode=1 # vertical mode;
internaldef hmode=2+maxopcode # horizontal mode;
internaldef mmode=3+2*maxopcode # math mode;
comment The purpose of the semantic routines is generally to construct lists
of box nodes: in vertical mode we build vlists and in horizontal mode we
build hlists. (In math mode, mlists are formed and converted into hlists or
vlists by subsequent processing.) These lists are generally queues (first-in-
first-out), so two pointers head and curnode are kept, with links pointing
away from head:
head curnode
↓ ↓
------- ------- ------- -------
| | *+--→ | | *+--→ | | *+--→ | | |
------- ------- ------- -------
In an empty list we have curnode=head and mem[head]=0. In a one-node list,
curnode points to the single node, mem[head]=curnode, and link(curnode)=0.
The one-word node pointed to by "head" is allocated upon entering a new
semantic level and freed upon leaving it.
The following SAIL macro can be used to append a new one-word node, containing
the value x, to the current list;
define store(x)=⊂begin integer o; o←curnode; getavail(curnode);
mem[o]←mem[o]+curnode; mem[curnode]←x; end⊃ # stores new item x;
comment Here x should have 0 in its link field.
An auxiliary real parameter is also maintained at each level of nesting.
In horizontal mode this is the "spacefactor" that is used to multiply
the amount of glue stretching and shrinking in variable spaces -- this factor
is normally 1.0, but it gets larger after periods and commas, etc.
In vertical mode the auxiliary parameter is called prevdepth, it is the
depth of the most recent box on the list. This is used to calculate
inter-line glue. If there are no boxes on the list, or if a rule follows
the most recent box, prevdepth is set to the special value "pflag", indicating
that no inter-line glue should precede the next box. In math mode, the
auxiliary parameter is type integer and called "incompleatnoad". It is normally zero,
but after passing \above or a similar operation it points to the partially
assembled mlist containing the numerator.
;
internaldef flag=⊂(1 rot -1)⊃ # most significant bit of word;
internaldef fflag=⊂(3 rot -2)⊃ # two most significant bits of word;
define pflag=⊂(0.0 lor flag)⊃ # flag, but treated as type real by the compiler;
comment The page builder.
Routines to build pages and periodically emit them to the output occupy
the lowest level of semantic nesting (nestptr=0). These routines
deal will several special variables and lists.
First there is "pagesize", which is set to the current value of \vsize
when the first entry is about to be placed onto a page. Similarly,
"pagedepthmax" is set to the current value of \maxdepth.
The main vlist for the current page starts at pagehead (a fixed location in
mem), and the most-recently-added node is pointed to by pagetail. This
list is distinct from the list corresponding to head and curnode when
in vmode -- the latter list contains contributions that are to be added
to the current page, but some of them might not get in immediately.
Sometimes lines are taken off the current page and inserted at the beginning
of this contribution-list.
Besides the current page list and the contribution list there is also a
waiting list, consisting of insert nodes for vlists that didn't fit
on the current page. The waiting list is appended to the front of the
contribution list each time a new page is started. The relevant pointers
to this list are waitinghead and waitingtail.
The variable "emptypage" is used to control the top baseline and removal
of glue and penalty items at the top of a page. It equals 2 when the page
contains nothing but mark or whatsit nodes, it equals 1 when the page contains
at least one insert but no other boxes or rules, it equals 0 after the first
non-inserted box or rule has been placed.
The currently best known place to break the current page is maintained in
the pointer variable curbreak (i.e., curbreak points to the final node
before the break), and the resulting badness is called curbadness. The
height and depth of the current page vlist are stored in pageheight and
pagedepth. The height (but not the depth) of inserts and separators is
included in pageheight, while pageinsdepth[0:1] has the other depths.
The total glue variability is stored in pagestretch and pageshrink;
real pagesize # desired height of current page;
real pageheight # actual height of current page;
real pagedepth # actual depth of current page;
saf integer array pageinsdepth[0:1] # depth of bot:top inserts;
real pagedepthmax # bound on allowable page depth;
real pagetopbl # bound on position of first baseline;
real pagestretch, pageshrink # total glue variability on current page;
integer pagetail # most recent node on current page;
integer waitingtail # most recent node on waiting list for inserted vlists;
integer emptypage # glue and penalty items should be deleted;
boolean finaleject # send and mark nodes should be ejected even on emptypage;
saf boolean array insabsent[0:1] # there is no botins:topins on current page;
integer curbreak # best known place to break on current page;
real curbadness # badness rating if break occurs at curbreak;
define contrib=⊂mem[contribhead]⊃ # first contribution;
comment The routine addtopage is used to take nodes from the contribution list and
append them to the current page list, calculating the best place to break.
As soon as pagelength exceeds pagesize+pageshrink, the current page is
ejected at the best-found place and the output routine is invoked. Then
addtopage resumes, until the contribution list has been emptied.
The following procedure is used in the addtopage routine when a
permissible break is encountered up to and including node curtail.
It updates curbreak and curbadness and returns true if it is time to
output the page up to and including node curbreak;
boolean procedure testpagebreak(real penalt);
begin real glue,badness,trueht;
if pagehead=pagetail then return(false);
trueht←pageheight;
if emptypage=0 or not insabsent[0] then trueht←trueht+pageinsdepth[1];
if not insabsent[0] then trueht←trueht+pagedepth;
if trueht>pagesize then
begin glue←pageshrink; if glue≤0.0001 then glue←.0001;
if trueht>pagesize+glue then
begin if curbreak=0 then curbreak←pagetail;
comment In this case the page will be too long, but we took
the first possible break;
return(true);
end;
badness←(trueht-pagesize)/glue;
end
else begin glue←pagestretch; if glue≤0.0001 then glue←.0001;
badness←(pagesize-trueht)/glue;
end;
badness←badness↑3+penalt;
if badness≤curbadness then
begin curbreak←pagetail; curbadness←badness;
end;
return(false);
end;
comment The following global variables are of concern to the output routine;
internal saf integer array kount["0":"9"];
comment \count0 (kount["0"] is page number used in messages to user);
internal saf integer array savedkount["0":"9"] # value of kount["0":"9"]
before output routine invoked;
internal integer savedpageno # value of kount["0"] before output routine invoked;
internal boolean outputdormant # true if the user output routine is not active;
internal integer topmark,botmark,firstmark # pointers to the mark tokenlists;
integer outputroutine # pointer to the user output routine;
comment The following are the dimension parameters;
internaldef pagememsize=6 # number of page parameters;
internal saf real array pagemem[0:pagememsize-1] # page parameters;
internaldef hsizemem=0 # location where hsize is stored in pagemem;
internaldef vsizemem=1 # location where vsize is stored in pagemem;
internaldef maxdepthmem=2 # location where maxdepth is stored in pagemem;
internaldef parindentmem=3 # location where parindent is stored in pagemem;
internaldef topbaselinemem=4 # loc where topbaseline is stored in pagemem;
internaldef mathsurrmem=5 # loc where mathsurround is stored in pagemem;
internaldef varunitmem=6 # loc where varunit is stored in pagemem;
internaldef lineskiplimitmem=7 # loc where lineskiplimit is stored in pagemem;
comment Introduction to math formula processing and data structures for mlists.
When TEX first reads a formula enclosed between $'s, it constructs an mlist that
is essentially a tree structure representing that formula. (An mlist is
linear, but the tree structure comes in since mlists can appear in mlists.)
The entire formula is "parsed" into such a tree before any of the processing
is done, because the current style of type is not always known while an
mlist is being scanned. For example, in $a+b \over c+d$ the fact the a+b will
be in script size is not discovered until \over has occurred. Each element of the
mlist is classified as, e.g., a relation, a binary operator, an open parenthesis,
etc., or as a construct like sqrt that must be built up. Subscripts and
superscripts are attached to these mlist elements, as mlists themselves.
After the formula has been entirely input, the mlst is evaluated, i.e.,
converted to an hlist. This is controlled by a recursive procedure with
reasonably simple structure: First all sub-mlists are evaluated, according to
the appropriate style determined from the outside in. Then the constructed
subformulas are built, using a combination of hlists and vlists, and
sub/superscripts are attached. Finally spacing is inserted, together with
any necessary penalty break nodes, and an hlist results.
One consequence of this two-pass operation is that if \mathrm, say, appears
anywhere within a formula, it applies to the whole formula. (The three fonts
defined by \mathrm are "sticky", i.e. their influence does not disappear
outside the block in which they occur.)
The math routines refer to 10 fonts (\mathrm, \mathit, \mathsy in text
size, script size, and script-script size, plus the \mathex font), and these
should have special characters in fixed positions as discussed in the TEX user
manual. Actually TEX keeps an internal table of 12 fonts, with mathfonttable(3),
(7), and (11) all equal to the number of the \mathex font.
Conversion of an mlist to an hlist takes place in eight different styles:
dispstyle used in displayed formulas
textstyle used in formulas within a text line
scriptstyle used in sub/superscripts
scriptscriptstyle used in sub/superscripts of sub/superscripts
plus a variant of these styles used when the formula is under a bar line. (In
the variant style, superscripts are set somewhat lower.) There are three
sizes of type, text size being used for both dispstyle and textstyle.
The following tables specify the dependence of size and style on context;
internaldef dispstyle=0,textstyle=1,scriptstyle=2,scriptscriptstyle=3;
comment Adding 4 to the style code gives the code for the variant style;
internaldef mathfonttable(f)=⊂eqtb[f+hashsize+384]⊃ # font numbers for math
typesetting, depending on type size:
(0) is text size rm,
(1) is text size it,
(2) is text size sy,
(3) is ex,
(4) is script size rm, etc., for 0≤f≤11;
define textsize=0,scrsize=4,scrscrsize=8;
preload_with textsize,textsize,scrsize,scrscrsize,
textsize,textsize,scrsize,scrscrsize; saf integer array fontsize[0:7] #
the size associated with a given style;
preload_with scriptstyle,scriptstyle,scriptscriptstyle,scriptscriptstyle,
scriptstyle+4,scriptstyle+4,scriptscriptstyle+4,scriptscriptstyle+4;
saf integer array scrstyle[0:7] # the superscript style associated
with a given style;
preload_with dispstyle+4,textstyle+4,scriptstyle+4,scriptscriptstyle+4,
dispstyle+4,textstyle+4,scriptstyle+4,scriptscriptstyle+4;
saf integer array undstyle[0:7] # the variant style associated with
a given style;
preload_with textstyle,scriptstyle,scriptscriptstyle,scriptscriptstyle,
textstyle+4,scriptstyle+4,scriptscriptstyle+4,scriptscriptstyle+4;
saf integer array numstyle[0:7] # numerator style associated with
a given style;
preload_with textstyle+4,scriptstyle+4,scriptscriptstyle+4,scriptscriptstyle+4,
textstyle+4,scriptstyle+4,scriptscriptstyle+4,scriptscriptstyle+4;
saf integer array denomstyle[0:7] # denominator style associated with
a given style;
comment Now let us consider the internal representation of an mlist. For purposes
of this documentation, mlist elements are called noads, with apologies to English
language purists.
Most noads are four words long, having three major one-word subfields called
operand, supscr, subscr.
Each of these major subfields is either zero or an encoded math character
or a pointer to an mlist or a pointer to a box node. During the processing,
encoded math characters and mlist pointers become converted to box
pointers. Mlist pointers are identified by having the two most significant
bits 11. Math characters are identified by having sign bit 1, next bit 0, and
with the least significant 9 bits containing the actual character code:
codes '000 thru '177 stand for the \mathrm font
codes '200 thru '377 stand for the \mathit font
codes '400 thru '577 stand for the \mathsy font
codes '600 thru '777 stand for the \mathex font
where the actual font has text size, script size, or script-script size
according to context. Thus, for example, the subfield '400000000301 stands
for italic letter A. (A complete table of TEX font codes appears in the
user manual.)
The subscr and supscr fields refer to the subscript and/or superscript
attached to this noad, if any. The operand field refers to the main-line
character(s) associated with this noad. The type of noad is used mostly
to control spacing in the formula: for example, a box noad followed by an
op noad (possibly separated by non-mlist noads) will eventually be
separated by a "thin space".
Type 0 noad: Box or character. The operand is an ordinary character or a
possibly complex box, treated as a normal math symbol.
If the value field of this noad is 1, the box will be raised or
lowered so that its center occurs at the axis of the formula
(the fraction-line position).
Type 1 noad: Op. The operand is an operator like lim or log, or a single character
from \mathex font like an integral sign or summation sign.
If the value field of this noad is 1, the limits to this operator
will be placed nonstandardly in display style (i.e., at the right
instead of centered or vice-versa).
Type 2 noad: Bin. The operand is a binary operator like "+".
Type 3 noad: Rel. The operand is a relational symbol like "=".
Type 4 noad: Opener. The operand is a left-bracket symbol like "(".
Type 5 noad: Closer. The operand is a right-bracket symbol like ")".
Type 6 noad: Punct. The operand is a punctuation symbol like ",".
;
internaldef boxnoad=0, opnoad=1, binnoad=2, relnoad=3, opennoad=4, closenoad=5,
punctnoad=6;
define operand(p)=⊂mem[p+1]⊃, supscr(p)=⊂mem[p+2]⊃, subscr(p)=⊂mem[p+3]⊃;
define supdelta=supmrk-2 # supscr(p)=mem[p+supmrk-supdelta], subscr(p) is analogous;
define noadsize=4;
comment The next few noad types represent operators that will be applied to their
operands and converted to box noads before spacing is done.
Type 7 noad: Sqrt. The operand will be preceded by a radical sign of appropriate
size and overbarred.
Type 8 noad: Overline. The operand will be overbarred.
Type 9 noad: Underline. The operand will be underbarred.
Type 10 noad: Accent. The accent (which is specified in the value field as a
9-bit code) will be placed over the operand, centered and moved right
according to the italic shift of the first character of the operand.
Type 11 noad: Above. This noad has 6 words instead of 4. The supscr and subscr
fields hold numerator and denominator, while the operand field is replaced by
the thickness of the desired rule. The two additional words hold left and
right delimiters to be placed around the completed construct.
;
internaldef sqrtnoad=7,overnoad=8,undernoad=9,accentnoad=10,abovenoad=11;
define aboverule(p)=⊂memreal(p+1)⊃;
define ldelim(p)=⊂mem[p+4]⊃, rdelim(p)=⊂mem[p+5]⊃;
comment "Delimiters" used in abovenoads and in the next two types of noads
are given in 18-bit code, as two juxtaposed 9-bit math characters. The
lefthand character refers to a smaller size variant of the symbol, when
it exists (e.g. a normal left parenthesis found in the \mathrm font), and
the righthand character refers to the larger size variants found in the
\mathex font. If the delimiter field is zero, the delimiter is blank,
which essentially means 2/3 of a thin space.
Type 12 noad: Left. The operand specifies a delimiter, in the format just
described. The supscr and subscr fields will remain zero, but they are
present in order to allow easy conversion of leftnoads to opennoads.
Type 13 noad: Right. Same as leftnoads, but eventually converted to closenoads;
internaldef leftnoad=12,rightnoad=13;
comment The final noad types specify insertions of boxes and glue and
penalties and style changes, etc. into mlists.
Type 14 noad: Node. One word long, the value field if nonzero points to a gluenode
or penaltynode or discnode or ejectnode (or possibly a whatsitnode). Such a
noad is ignored by the math spacing routine, simply passed along into
the final hlist.
Type 15 noad: Style. One word long, the value field specifies a style to
be applied to the following noads (unless overridden by another stylenoad).
This sort of noad is also used to indicate context-dependent variable glue
specified by the TEX user (e.g. thick and thin and quad spaces);
internaldef nodenoad=14, stylenoad=15;
internaldef thinspace=8,thickspace=9,quadspace=10,negthinspace=11,negthickspace=12,
negopspace=13,userspace=14,nospace=7,opspace=17,thspace=15,negthspace=16,mspace=18;
comment "nospace" is used only in the array spacetable
that controls inter-element spacing in an mlist. "mspace" noads are always followed
by nodenoads for \hskip but the units are in mu instead of pt;
comment The following procedures illustrate the data structure described above.
They print out the top levels of an mlist, in a manner analogous to the
procedures dumpnodelist and tracedump;
forward recursive procedure dumpnoadlist(integer p;string indent;integer thresh,n);
recursive procedure dumpnoadfield(integer p; string indent; integer thresh,n);
begin comment This procedure, which is called only by the procedure dumpnoadlist,
displays the equivalent of a field in a noad;
if length(indent)>thresh then return;
if p=0 then return;
if p>0 then dumpnodelist(p,indent,thresh,n) comment p is pointer to ordinary node;
else if (p lsh 1)<0 then dumpnoadlist(p land ((1 lsh infod)-1),indent,thresh,n)
comment p points to an mlist;
else print(nextline,indent,"'",cvos(p land '777)) # p is a math character;
end;
recursive procedure dumpnoadlist(integer p; string indent; integer thresh,n);
begin comment This diagnostic routine is analogous to dumpnodelist, except
that p points to an mlist;
integer c,t,m,v;
if length(indent)>thresh then return;
c←0;
while p do
begin print(nextline,indent);
if p<0 or p≥memsize then
begin print("Bad link, dump aborted."); done;
end;
if (c←c+1)>n then
begin print("etc."); return;
end;
t←field(type,m←mem[p]);v←field(value,m);
case t of begin
[boxnoad][opnoad][binnoad][relnoad][opennoad][closenoad][punctnoad]
[sqrtnoad][overnoad][undernoad][accentnoad][abovenoad] begin
print(case t of("box","op","bin","rel","open","close","punct",
"sqrt","over","under","accent","above"),"noad");
if v then print(v);
if t=abovenoad then print(cvf(aboverule(p)),", leftdelim'",
cvos(ldelim(p)),", rightdelim'",cvos(rdelim(p)))
else dumpnoadfield(operand(p),indent&".",thresh,n);
if supscr(p) then dumpnoadfield(supscr(p),indent&"↑",thresh,n);
if subscr(p) then dumpnoadfield(subscr(p),indent&"↓",thresh,n); end;
[leftnoad][rightnoad] print(case t-leftnoad of("left","right"),
"delimiter '",cvos(operand(p)));
[nodenoad] begin print("nodenoad");
if v then dumpnodelist(v,indent&".", thresh, n) end;
[stylenoad] print("stylenoad", v);
else print("Unknown noad type!") end;
p←link(p);
end;
end;
procedure tracedumpmath(integer p) # calls dumpnoadlist with tracing threshold;
dumpnoadlist(p,null,(tracing lsh -6)land '777,
if tracing≥'100000 then (tracing lsh-15)land '777 else 5);
comment Many of the characters used in math mode are predefined control
sequences associated with the "mathonly" command. For example, the TEXPRE
module contains the statement
identer("lfloor",mathonly,opn('542))
which means that the control sequence \lfloor will stand for the character
'542 (namely '142 in the \mathsy font), and will be classified as a
left bracket (an opennoad). But ordinary characters also are given a
special interpretation in math mode -- for example, letters are treated
as italic, but digits are not, and some special symbols are taken from
the \mathsy font. The mathdecode table (see TEXPRE) contains the default
specifications for this input conversion;
comment The following variables are used to govern the layout of displayed
equations. Processing of displays is a relatively straightforward addition
to the processing of math formulas in text lines, most of the code for this
appears in procedure "finishdisplay";
integer eqnobox # points to box containing an equation number, if present;
integer dpenalty # special penalty to be inserted before glue following display;
boolean leqno # 0 or 1 if most recent equation number was \eqno or \leqno;
real abovedisplaywidth # amount of text on the line before a displayed equation
(if small enough, the dispskip glue will be omitted over the equation);
comment Maintaining the semantic stacks: pushnest,popnest,decodemode,dumpactivities;
simp procedure pushnest # store current semantic status, begin a new (empty) list;
begin if nestptr≥nestsize then overflow(nestsize);
modestack[nestptr]←mode;
headstack[nestptr]←head;
curndstack[nestptr]←curnode;
auxstack[nestptr]←aux;
getavail(head); mem[head]←0; curnode←head;
nestptr←nestptr+1;
end;
simp procedure popnest # restore previous semantic status;
begin nestptr←nestptr-1 # This can't go negative, as page builder never quits;
freeavail(head) # N.B. no pointers to this node should remain;
mode←modestack[nestptr];
head←headstack[nestptr];
curnode←curndstack[nestptr];
aux←auxstack[nestptr];
end;
simp string procedure decodemode(integer m);
if m>0 then return(case (m-vmode)div(maxopcode+1) of
("vertical","horizontal","displayed math"))
else return(case(-m-vmode)div(maxopcode+1) of
("restricted vertical","restricted horizontal","math"));
IFSUAI define dumpmarkers=⊂"⊗⊗⊗ "⊃; elsec define dumpmarkers=⊂"### "⊃; ENDSUAI
simp procedure dumpactivities # show what TEX is doing;
begin comment This diagnostic procedure prints the partial lists being built
by TEX on each level of the semantic stacks;
integer ptr,md;
pushnest; popnest # stores top level variables in the arrays;
for ptr←nestptr step -1 until 0 do
begin print(nextline,dumpmarkers,decodemode(md←modestack[ptr]));
if abs(md)=vmode and auxstack[ptr] xor pflag then
print(", prevdepth",cvf(auxstack[ptr]));
if abs(md)=hmode then print(", spacefactor",cvf(auxstack[ptr]));
if abs(md)=mmode then
begin if auxstack[ptr] then
begin print(" with incompleatnoad:");
tracedumpmath(memory[location(auxstack[ptr]),integer]);
print(nextline);
end;
tracedumpmath(mem[headstack[ptr]]);
end
else tracedump(mem[headstack[ptr]]);
end;
print(nextline,dumpmarkers&"current page:"); tracedump(mem[pagehead]);
if waitingtail≠waitinghead then
begin print(nextline,dumpmarkers&"holdovers:");
tracedump(mem[waitinghead]);
end;
print(nextline,dumpmarkers&"nesting level ",(curlev-level1)lsh -idlevd);
end;
comment Font information. (New specifications due to Lyle Ramshaw, November 1980.)
Each font used by TEX has an associated font information file.
The name of this file is obtained by appending the extension
code ".TFM" to the font file name. For
example, the TEX font metrics for the font CMR10 appear on the
file CMR10.TFM. These .TFM files are written with 32 bits in each
word, to facilitate their transportability. When they sit in the
file systems of PDP-10's, these 32 data bits will be left-justified
in the PDP-10's 36-bit word, leaving the rightmost four bits zero.
The first 6 words of the .TFM file contain twelve 16-bit integers
that give the lengths of the various portions of the file, packed two
to a 32-bit word. These twelve integers are, in order:
lf=length of entire file in words,
lh=length of header data,
bc=first character code in font,
ec=last character code in font,
nw=number of words in width table,
nh=number of words in height table,
nd=number of words in depth table,
ni=number of words in italic correction table,
nl=number of words of lig/kern program,
nk=number of words in kern table,
ne=number of words in extensible character table,
np=number of font parameters.
In .TFM format, the subfields of a word are always allocated in
left-to-right (BigEndian) order. Thus, the first two integers
in this list, lf and lh, are packed into the first word of the
.TFM file with lf on the left and lh on the right.
These lengths are not all independent: they must obey the relation that
lf=6+lh+(ec-bc+1)+nw+nh+nd+ni+nk+nl+ne+np.
The rest of the .TFM file is a sequence of ten data arrays as specified
below:
HEADER= ARRAY[0:lh-1] of Stuff
FINFO= ARRAY[bc:ec] of FInfoEntry
WIDTH= ARRAY[0:nw-1] of FIX
HEIGHT= ARRAY[0:nh-1] of FIX
DEPTH= ARRAY[0:nd-1] of FIX
CHARIC= ARRAY[0:ni-1] of FIX
LIG/KERN= ARRAY[0:nl-1] of LigKernStep
KERN= ARRAY[0:nk-1] of FIX
EXT= ARRAY[0:ne-1] of ExtRecipe
PARAMS= ARRAY[1:np] of FIX.
A FIX is a one-word representation of a real number in a fixed-point
fashion. FIX'es are used in .TFM format to enhance transportability.
A FIX is a signed quantity, with the two's complement of the entire FIX
used to represent negation. Of the 32 bits in the word, 12 are to the
left and 20 are to the right of the binary point. This means that a
FIX has 1 bit of sign, 11 bits of integer, and 20 bits of fraction.
Note that this limits the size of real numbers that a FIX can represent:
the largest FIX is roughly 2000.
The first data array is a block of header information,
general information about the font. Currently, the header contains
18 words, allocated as described below. In the future, new fields might
be added at the end of the header block.
HEADER=
[
CheckSum: 1 word
DesignSize: FIX (1 word)
CharacterCodingScheme: 10 words
ParcFontIdentifier: 5 words
Random word (=Header[17] is broken up as follows:)=
[
SevenBitSafe: 1 bit
unusedspace: 23 bits
ParcFaceByte: 8 bits
]
]
The CheckSum field is used to hold a unique identifier of some sort that
describes this version of the font. This unique ID is put by Metafont into
both the rasters and metrics. TEX finds it in the metrics, and stores it in
the .dvi file. Thus, a spooler can check the unique ID in the .dvi with
the unique ID in its rasters, to provide a guarantee that TEX was working
with metric data for the current rasters. Metafont computes this checksum
from the metric information in the .tfm file.
The DesignSize of the font is the size that the font was intended to look
good at, or, to put it another way, the nominal size of the font when
it is printed at a magnification of 1.0. For unusual fonts such as CMDUNH
and CMATHX, the DesignSize is more-or-less arbitrary. The
DesignSize is stored as a FIX with the units "points".
The CharacterCodingScheme field is supposed to specify what the character
code to symbol translation scheme is in this font. The coding scheme is
stored in 10 words=40 bytes of the .tfm file, as a string. The first byte
gives the length of the string, the next n bytes are the characters, and the
last (39-n) bytes are zeros (where "first" and "next" imply working from
left-to-right). Some common coding scheme names
are:
CharacterCodingSchemes:
UNSPECIFIED --default, means no information
GRAPHIC --special purpose code, non-alphabetic
ALPHABETIC --means alphabet agrees with ascii at least
ASCII --means exactly ascii
TEX TEXT
TEX TYPEWRITER TEXT
TEX MATHIT
TEX MATHSY
TEX MATHEX
PARC TEXT --TimesRoman and Helvetica, for example
SUAI
CMU
MIT
At SAIL, fonts are universally referred to by their file names: for
example "CMR10" for Computer Modern Roman 10 point, "CMTT" for Computer
Modern TypeWriter Type 10 point, etc. The TEX user specifies the font
by giving this string name, the TEX output module finds the metric file
by using this name with the extension .TFM, and
the various printers store the rasters as files with this name and some
other extension. At Parc, however, fonts are not stored in separate files
but rather in mammoth things called dictionaries. And a font is referred
to not by a file name, but rather by a "family name" (a string of no
more than 19 characters), a "face" (a byte), and a "size" (sixteen bit
integer in units of micas). The remaining fields of the HEADER portion
of the file specify the "family name" and "face" byte that should be
used to refer to this font at PARC or in Press files. The family
name is stored in 5 words=20 bytes. the first byte gives the length n of the
string, the next n bytes are the characters, and the last (19-n) bytes
are zero. The PARC face byte is stored in the right-most byte of
the Random word .
(Wizards: In the current PARC scheme, the
face byte for MetaFont-generated fonts is a simple funtion of the
DesignSize. The face byte for PARC fonts is a small integer chosen
according to a scheme documented in the memo "FontFormats".)
The SAIL implementation of TEX (and possibly some others) can only
handle character codes that are seven bits in length. But the .TFM
format always allows a full eight bits for a character code.
Furthermore, we want the SAIL TEX to be able to read and use .TFM
files that describe eight bit fonts, simply by throwing away the
information specifically about eight bit character codes. In order
to make this work safely, however, the .TFM's must have the property that
no eight-bit codes can arise out of seven bit codes in the normal running
of TEX. In particular, the following three properties must hold:
i) No seven bit character ligs with a seven bit character to
produce an eight bit character
ii) All of the pieces of an extensible seven bit character
must be seven bit characters
iii) No charlist can lead from a seven bit character up to
an eight bit character.
If a .TFM file is guaranteed to have these properties, then it is
legal to set the SevenBitSafe bit, which is the sign bit of the
Random HEADER word. The SAIL implementation of TEX will scream if
it reads a .TFM file that describes eight bit characters, but for
which the SevenBitSafe bit is zero.
IFPARC
At Parc, an extension has been implemented which allows the SAIL
implementation of TEX to output Press files with eightbit character
codes by the following hack: if "\x eightbit" appears in the
TEX input, then the next "\font" will get the eightbit half of the
font instead of the seven bit half. No attempt is made in
ReadFontInfo to adjust any charcter codes that appear in the font
information tables. Hence, for this hack to work, the font metrics
must satisfy some additional properties:
iv) No eightbit character has a ligature or kerning program
v) No eightbit character is extensible
vi) No eightbit character is part of a charlist
At Parc, these additional properties are required of any font that
claims to be SevenBitSafe.
ENDPARC
The HEADER data is followed by the FINFO table, which is an array
of FInfoEntries. This array is indexed from bc to ec, and hence contains
(ec-bc+1) entries. Each FInfoEntry is one word in length. An FInfoEntry
is a compacted structure with the following format
(fields allocated from left to right once again):
FInfoEntry:
[
WidthIndex: 8 bits
HeightIndex: 4 bits
DepthIndex: 4 bits
CharIcIndex: 6 bits
TagField: 2 bits
Remainder: 8 bits
]
The FINFO portion of the .TFM file is read into TEX's array
fontinfo[128f:128f+127]. (Note that there are four free bits at
the right-hand end of each word in the fontinfo array. One of
these may be used by TEXOUT to mark those characters that actually
occur.)
The fields in the FInfoEntry do not give the character width, height,
etc. directly, they are indices into secondary tables. Thus, up to 256
different widths may appear among the 256 characters of a single font,
and up to 16 different heights, 16 different depths, and 64 different
italic corrections. The actual widths, heights, depts and italic
corrections are stored in the .TFM file as arrays of FIX's with
"ems" as their units. TEX reads in these FIX's, converts them to
floating point form, scales them by multiplying by the desired
font size (in points), and stores them into internal character metric
arrays.
The CharIc field is used both for the italic correction of ordinary
characters and for mathop kerns. In particular, for mathops
such as summation and integral signs, the CharIc field points
to a "kern" which, if nonzero, means that limits are normally
set to the right and the lower limit is shifted left by this
kern value. If the kern is 0, it means that limits in display
style will be centered above and below the operator. (To change
between centering and attaching at the right, one writes
"\limitswitch" after the operator.)
A note on non-existent characters: all character codes outside of the
range [bc,ec] represent characters that do not exist in the font. Any
codes in the range [bc,ec] that represent non-existent characters will
have their FInfoEntries identically equal to 0. The WIDTH,
HEIGHT, DEPTH, and CHARIC arrays will each be guaranteed to
have a FIX of 0.0 in their 0'th position. Thus, failing to notice that
a character is non-existent won't lead a program to use irrelevant
metric data for that character code. Furthermore,
any characters that really do exist in the font will be guaranteed to
have a WidthIndex that is nonzero. Thus, a character is non-existent
iff its WidthIndex is zero, and also iff its entire FInfoEntry is zero.
If there are any actual characters in the font whose width just
happens to be precisely zero, the WIDTH
array will contain two zero FIX's: one at index 0, which is used
for all of the non-existent characters, and one somewhere else.
The remaining portion of the FInfoEntry is used for several different
purposes, depending upon the value of the tag field. The TagField portion
of the FInfoEntry has one of four values:
tag=0 => this is a vanilla character, Remainder is unused.
tag=1 => this character has a ligature-kerning program
the Remainder field is the index in the LIG/KERN
array of the first step of the program.
tag=2 => this character is part of a chain of characters of
ascending sizes ("charlist"): the Remainder field
gives the character code of the next larger character
in the chain.
tag=3 => this character code represents an extensible character,
one that is built up out of smaller pieces and can
be made arbitrarily large: the Remainder field is
an index into the EXT array. The ExtRecipe at that
position in the EXT array describes what the pieces are.
(In programs, these four values might be called:
tagnone(=0), taglig(=1), taglist(=2), and tagvar(=3)
respectively. The taglist and tagvar options are usually used
only in math extension fonts.)
The LIG/KERN array is a program in a simple programming language that
gives instructions about what to do for special letter pairs. Each step
in this program occupies one word:
LigKernStep:
[
StopBit: 1 bit # means this is a final program step
unusedspace: 7 bits
nextChar: 8 bits # if this is the next character, then...
TagBit: 1 bit
unusedspace: 7 bits
Remainder: 8 bits
]
If the TagBit is 0 (define LigStep=0), this step in the program describes
a ligature. In that case, the Remainder consists of the character
code of the ligature that should be substituted for the current character
pair. If the TagBit is 1 (define KernStep=1), this step describes a kern,
and the Remainder field is an index into the KERN array. The KERN array
is simply an array of FIX's, pure numbers that should be scaled to give
distances in the same way as the elements of the WIDTH, HEIGHT,
DEPTH, and CHARIC arrays.
An ExtRecipe is a one-word quantity that should be viewed as four
bytes (allocated left-to-right, of course):
ExtRecipe:
[
top: byte
mid: byte
bot: byte
ext: byte
]
The height and width fields in the FInfoEntry of the extensible
character give the metrics of the component, not of the built-up
symbol itself, since the built-up symbol will have variable size.
If top, middle, or bottom portions are zero,
the extension component runs all the way through that
portion of the symbol, otherwise it directly abuts these portions. The
built-up symbol is formed by including an integral number of extension
components. If there is a middle, the same number of extension components
will appear above and below. For example, a left brace has all four
components specified, while a double | (the cardinality or norm symbol)
has only an extension part. The floor and ceiling brackets are like regular
brackets, but without top or bottom, respectively. The width of the
extension component is assumed to be the width of the entire built-up symbol.
If any byte is 0, it indicates that the corresponding piece of the extensible
character does not exist. Otherwise, the contents of the byte is the
character code of the piece: top, middle, bottom, or extender respectively.
The rest of the .TFM file is the PARAMS array, a table of font parameters
that are used by TEX, stored as FIXes. All of these parameters are
distances except for the first one, "slant": hence all except for
"slant" should be scaled by the font size by TEX when being read in from
the .TFM file. Since slant is a pure number, it should not be scaled.
[The following table of parameters is printed in clearer form on pages
98-100 of the Metafont manual.]
slant the amount of italic slant
(e.g. slant=.25 means that when going up one unit, go .25 units to the
right--this is used in placing accents over characters)
space a real number that says how wide blank spaces are
(Note that TEX doesn't use character number '40 for spaces,
that character can be non-blank in the font)
spacestretch the stretch component of the glue for spacing
spaceshrink the shrink component of the glue for spacing
xheight the height of lowercase "x" (default positioning for accents)
quad the width of one "em"
extraspace the amount added to space after periods
(and in general when the spacefactor is greater than 2)
Mathematics fonts used as \mathsy and \mathex contain important additional
parameter information. In a \mathsy font, the extra parameters start right
after "quad", that is, there is no "extraspace" parameter. The
\mathsy parameters are
mathspace if nonzero, the amount of space that will be used
for all nonzero space in math formulas (for fixed-width output).
num1,num2,num3 amount to raise baseline of numerators in display or
nondisplay or nondisplay-atop styles, respectively
denom1,denom2 amount to lower baseline of denominators
sup1,sup2,sup3 amount to raise baseline of superscripts if 1) display style
2) nondisplay nonvariant style 3) variant style
sub1,sub2 amount to lower baseline of subscripts if superscript
is 1) absent 2) present
supdrop,subdrop amount below top or bottom of large box to place baseline
if the box has a superscript or subscript
in this size
delim1,delim2 size of \comb delimiters in 1)display 2)nondisplay style
axisheight height of fraction lines above the baseline
(this is midway between the two bars of = sign)
A \mathex font includes the first seven standard parameters
(including extraspace), and then has six parameters used to
govern formula setting:
defaultrulethickness, the thickness of \over and \overline bars
bigopspacing(1),(2), the minimum glue space above and below a large
displayed operator, respectively
bigopspacing(3),(4), the minimum distance between a limit's baseline
and a large displayed operator, when the limit is above, below
bigopspacing(5), the extra glue placed above and below displayed limits
This long comment is about to end.
;
internaldef nfonts=64 # number of fonts allowed (must be power of two);
internaldef fmemsize=8000 # size of font memory for secondary tables;
internal saf integer array fmem[0:fmemsize-1] # font memory for secondary font info;
internal integer fmemptr # first unused location in fmem;
internaldef fmemreal(k)=⊂memory[location(fmem[k]),real]⊃;
comment the 7-bit char assumption is too deeply built in!;
internal saf integer array fontinfo[0:128*nfonts-1] # primary font info table;
internal saf integer array wdbase,htbase,dpbase,icbase,lgbase,krbase,
extbase, parbase[0:nfonts-1] # base addresses in fmem for
secondary font tables;
internal saf integer array fcksum[0:nfonts-1];
internal saf real array fsize[0:nfonts-1] # at-size of fonts;
internal saf real array dsize[0:nfonts-1] # design size of fonts;
internal saf integer array fpfi[0:nfonts-1,1:5];
internal saf integer array fpfb[0:nfonts-1];
internaldef rmd=4,rms=8,tgd=12,tgs=2,icd=14,ics=6,dpd=20,dps=4,
htd=24,hts=4,wdd=28,wds=8;
internaldef tagnone=0, taglig=1,taglist=2,tagvar=3;
internaldef charwd(f,t)=⊂fmemreal(wdbase[f]+field(wd,t))⊃
# width in font f, fontinfo t;
internaldef charht(f,t)=⊂fmemreal(htbase[f]+field(ht,t))⊃
# height in font f, fontinfo t;
internaldef chardp(f,t)=⊂fmemreal(dpbase[f]+field(dp,t))⊃
# depth in font f, fontinfo t;
define ligstep=0,kernstep=1;
define nextchar(x)=⊂(x lsh -20) land '377⊃;
define tagbit(x)=⊂(x lsh -19) land 1⊃;
define remainder(x)=⊂(x lsh -4) land '377⊃;
define lhalf(x)=⊂(x lsh -20) land '177777⊃;
define rhalf(x)=⊂(x lsh -4) land '177777⊃;
internaldef fontpar(f,t)=⊂fmemreal(parbase[f]+t)⊃ # parameter no. t in font f;
internaldef slant=0,spacewd=1,spacestr=2,spaceshr=3,xheight=4,quad=5;
internaldef extraspace=6;
define num1=7,num2=8,num3=9,denom1=10,denom2=11,sup1=12,sup2=13,sup3=14,
sub1=15,sub2=16,supdrop=17,subdrop=18,delim1=19,delim2=20,axisheight=21;
define mathpar(x,fsize)=⊂fontpar(mathfonttable(fsize+2),x)⊃;
preload_with sup1,sup2,sup2,sup2,sup3,sup3,sup3,sup3; saf integer array
suptable[0:7] # the superscript shift to use, as a function of style;
define defaultrulethickness=⊂mathpar(7,1)⊃;
define bigopspacing(i)=⊂mathpar(7+i,1)⊃;
internal procedure readfontinfo(integer chan,f; real psize;
boolean atclause) # reads font information file;
begin integer i,p,m,temp,lfl,lh,ec,bc,nw,nh,nd,ni,nl,nk,ne,np,fbt;
integer fc,lc # the first and last codes that TEX wants;
integer fbc,lec # endpoints of intersection of the range of existing codes
and the range of codes that TEX wants;
real metricscale;
temp←wordin(chan); lfl←lhalf(temp); lh←rhalf(temp);
temp←wordin(chan); bc←lhalf(temp); ec←rhalf(temp);
m←(lfl-lh-ec+bc-7);
if fmemptr+m≥fmemsize then overflow(fmemsize);
temp←wordin(chan); nw←lhalf(temp); nh←rhalf(temp);
temp←wordin(chan); nd←lhalf(temp); ni←rhalf(temp);
temp←wordin(chan); nl←lhalf(temp); nk←rhalf(temp);
temp←wordin(chan); ne←lhalf(temp); np←rhalf(temp);
fcksum[f]←wordin(chan) # checksum;
dsize[f]←wordin(chan)/(1 lsh 24) # design size;
metricscale←if atclause then psize else dsize[f];
fsize[f]←metricscale # size in points;
for i←1 thru 10 do temp←wordin(chan) # throw away character coding scheme;
for i←1 thru 5 do fpfi[f,i]←wordin(chan) # Parc Font Id;
fpfb[f]←(((fbt←wordin(chan)) lsh -4) land '377) # Parc Face Byte;
for i←1 thru lh-18 do temp←wordin(chan) # throw away rest of header;
fc←'000; lc←'177 # the range that TEX wants;
IFPARC
if nextfonteightbit then
begin comment use eightbit half of font instead;
fpfb[f]←(1 lsh (bitsperwd-1))+fpfb[f] # record in sign bit of fpfb;
nextfonteightbit←false # only applies for one \font;
fc←'200; lc←'377;
end;
ENDPARC
comment The font goes from [bc,ec], while TEX wants the range [fc,lc].
The following code throws away fontinfo for existing charaters
outside the TEX range, defaults fontinfo to zero for
nonexistent characters inside the TEX range, and reads in the
fontinfo for existing characters in the TEX range;
for i←bc thru fc-1 min ec do temp←wordin(chan);
for i←fc thru bc-1 min lc do fontinfo[(f lsh 7)+i-fc]←0;
fbc←fc max bc;
lec←lc min ec;
arryin(chan,fontinfo[(f lsh 7)+fbc-fc],(lec-fbc+1) max 0);
for i←lc+1 max bc thru ec do temp←wordin(chan);
for i←ec+1 max fc thru lc do fontinfo[(f lsh 7)+i-fc]←0;
comment Now give warnings for bad cases;
IFPARC if bc<fc and fbt≥0 then
error("Warning: eightbit portion of font not necessarily safe");
ENDPARC
if ec>lc and fbt≥0 then
error("Warning: font may contain accessible chars with illegal codes (above '177)");
p←fmemptr # the secondary tables go into fmem;
wdbase[f]←p;
htbase[f]←wdbase[f]+nw;
dpbase[f]←htbase[f]+nh;
icbase[f]←dpbase[f]+nd;
lgbase[f]←icbase[f]+ni;
krbase[f]←lgbase[f]+nl;
extbase[f]←krbase[f]+nk;
parbase[f]←extbase[f]+ne;
arryin(chan,fmem[p],m);
fmemptr←fmemptr+m;
define scale(x)=
⊂memory[location(fmem[x]),real]←(fmem[x]/(1 lsh 24))*metricscale⊃;
define funnyscale(x)=
⊂memory[location(fmem[x]),real]←(fmem[x]/(1 lsh 24))⊃;
for i←0 thru nw-1 do scale(wdbase[f]+i);
for i←0 thru nh-1 do scale(htbase[f]+i);
for i←0 thru nd-1 do scale(dpbase[f]+i);
for i←0 thru ni-1 do scale(icbase[f]+i);
for i←0 thru nk-1 do scale(krbase[f]+i);
funnyscale(parbase[f]) # slant;
for i←1 thru np-1 do scale(parbase[f]+i);
end;
comment Making lists into boxes: nullbox,hpackage,vpackage,hpack,vpack;
simp integer procedure nullbox;
begin comment returns a pointer to an empty box;
integer b; b←getnode(boxnodesize); mem[b]←hlistnode lsh typed; return(b);
end;
internal real str,shr # total stretch,shrink found by packaging routine;
internal integer procedure hpackage(integer head; real desiredwidth; boolean xpand);
begin comment This procedure runs through the hlist pointed to in mem[head]
and returns a pointer to a box formed from it. The width of the box is
desiredwidth, if xpand = 0
natural width + desiredwidth, if xpand ≠ 0 (expansion).
One consequence is that the box has its natural width if xpand = 1 and
desiredwidth = 0. The box may actually extend outside its computed
dimensions if the desired width is less than the natural width minus the
maximum amount of shrinkage.
The global variable mem[inserts] is set to point to a list of all topinserts
or botinserts or ejects or marks that are affixed to this hlist, and they are
removed from the hlist.
The global variables str,shr are set to point to the total stretch and
shrink of the glue;
integer c,t,f; real r # temporary storage;
integer p,prevp # current and previous node;
integer curins # tail of insert list;
real ht,dp,wd # computed height, depth, width;
real delta # difference of actual width from desired width;
mem[inserts]←0; curins←inserts # set insert list empty;
prevp←head; p←mem[head] # beginning of given hlist;
ht←dp←wd←str←shr←0.0 # computed height and depth will be ≥0;
while p do
begin case type(p) of begin
[charnode] begin t←fontinfo[c←info(p)];
f←c lsh -7; # font number;
wd←wd+charwd(f,t);
r←charht(f,t); if r>ht then ht←r;
r←chardp(f,t); if r>dp then dp←r end;
[hlistnode][vlistnode][rulenode][unsetnode] begin wd←wd+width(p);
if type(p)≠rulenode then r←shiftamt(p) else r←0.0;
if height(p)-r > ht then ht←height(p)-r;
if depth(p)+r > dp then dp←depth(p)+r end;
[whatsitnode] hpackext(p) # in case of extensions;
[kernnode] wd←wd+gluespace(p);
[gluenode] begin t←value(p);
wd←wd+gluespace(t);
str←str+gluestretch(t); shr←shr+glueshrink(t) end;
[leadernode][hyphnode][penaltynode][discnode];
[ejectnode][insnode][marknode] begin integer q; q←p; p←link(p);
if value(q)=0 then freeavail(q) comment linebreak nodes are discarded;
else begin comment move the node to the list of inserts;
mem[curins]←mem[curins]+q; curins←q; setlink(curins,0);
end;
setlink(prevp,p); continue end;
else confusion
end;
prevp←p; p←link(p);
end;
comment Now the statistics-gathering and node-shuffling is complete,
so we wrap it up;
p←getnode(boxnodesize);
mem[p]←(hlistnode lsh typed)+(mem[head] lsh valued);
if xpand then desiredwidth←wd+desiredwidth;
width(p)←desiredwidth; height(p)←ht; depth(p)←dp;
delta←desiredwidth-wd;
if delta≥0 and str>0.0 then glueset(p) ← delta/str
else if delta<0 and shr>0.0 then glueset(p) ← -1.0 max (delta/shr);
if delta<-shr-.1 and shr≥0.0 and tracing land 1 then
begin print(nextline,"Overfull box,",cvf(-delta-shr),
" points too wide:"); tracedump(p); print(nextline);
end;
if glueset(p)=0 and delta≠0 then glueset(p)←epsilon;
return(p);
end;
internal integer procedure vpackage(integer head; real desiredheight; boolean page;
integer xpand);
begin comment This procedure runs through the vlist pointed to in mem[head]
and returns a pointer to a box formed from it. The height of the box is
desiredheight, if xpand = 0
natural height + desiredheight, if xpand ≠ 0 (expansion).
One consequence is that the box has its natural height if xpand=1 and
desiredheight = 0. The box may actually extend outside its computed
dimensions if the desired height is less than the natural height minus the
maximum amount of shrinkage, or if boxes have been shifted left of the
reference point.
All topinserts are replaced by the corresponding vlist, which is moved to the
front of the list. Similarly, all botinserts move to the bottom (relative
order being otherwise preserved). Any mark nodes encountered will change
the value of "botmark". The first mark node will change the value of
"firstmark". The global variables str,shr are set to point to the total
stretch and shrink of the glue.
If "page" is true, the depth of the resulting box is constrained to be
at most pagedepthmax.
Warning: Parameter "head" must not equal "temphead" or "inserts", the latter lists
are destroyed by this procedure;
integer t; real r # temporary storage;
integer curbot # tail of list for botinserts, the head is temphead;
integer curtop # tail of list for topinserts, the head is inserts;
integer savep # pointer to return to in main list after an insert;
integer prevp,p # current node and previous node;
real ht,dp,wd # the box dimensions so far;
real savedp,topdp,botdp # depth at the end of each list;
real delta # difference of actual height from desired height;
label vloop,wloop # go through a vlist;
integer separator # pointer to top separator;
curbot←temphead; mem[temphead]←0 # botinsert list empty;
curtop←inserts; mem[inserts]←0 # topinsert list empty;
separator←0;
prevp←head; p←mem[head];
ht←dp←wd←shr←str←topdp←botdp←0.0;
vloop: savep←0 # no insert is in progress;
wloop: while p do
begin
case type(p) of begin
[charnode] begin integer c,f; t←fontinfo[c←info(p)];
f←c lsh -7 # font number;
r←charwd(f,t); if r>wd then wd←r;
ht←ht+dp+charht(f,t); dp←chardp(f,t) end;
[hlistnode][vlistnode][rulenode][unsetnode] begin ht←ht+dp+height(p);
dp←depth(p);
if type(p)≠rulenode then r←width(p)+shiftamt(p) else r←width(p);
if r>wd then wd←r end;
[whatsitnode] vpackext(p) # in case of extensions;
[gluenode] begin t←value(p);
ht←ht+dp+gluespace(t); dp←0;
str←str+gluestretch(t); shr←shr+glueshrink(t) end;
[leadernode][penaltynode][ejectnode];
[marknode] begin if botmark then delrclink(botmark); botmark←value(p);
mem[botmark]←mem[botmark]+refct1;
if firstmark<0 then
begin firstmark←botmark; mem[botmark]←mem[botmark]+refct1;
end;
end;
[insnode] begin t←value(p);
if savep then confusion # there are no inserts in inserts;
setlink(prevp,link(p)); freeavail(p) # we're done with this node;
if mem[t] land (1 lsh typed) then
begin comment topinsert;
if mem[t] land (4 lsh typed) then
begin comment topsep;
separator←t; p←link(prevp); continue;
end;
savedp←dp; dp←topdp;
savep←prevp; prevp←curtop;
end
else begin comment botinsert;
savedp←dp; dp←botdp;
savep←-prevp; prevp←curbot;
end;
mem[prevp]←mem[prevp]+(p←value(t));
freenode(t,insspecsize) # and we're done with this one too;
continue end;
else confusion
end;
prevp←p; p←link(p);
end;
if savep then
begin comment Finished with an insert list, must resume the original one;
if savep>0 then
begin curtop←prevp; topdp←dp;
end
else begin curbot←prevp; botdp←dp;
end;
dp←savedp; prevp←abs(savep); p←link(prevp); go to vloop;
end;
comment Now link in the inserts;
if separator then
begin comment First put the topsep below the topinserts;
savedp←dp; dp←topdp;
savep←prevp; prevp←curtop; mem[prevp]←mem[prevp]+(p←value(separator));
freenode(separator,insspecsize); separator←0;
go to wloop;
end;
if mem[temphead] then
begin mem[prevp]←mem[prevp]+mem[temphead] # this puts in the botinserts;
ht←ht+dp; dp←botdp;
end;
if mem[inserts] then
begin if mem[head] then
begin mem[curtop]←mem[curtop]+mem[head]; ht←ht+topdp;
end
else dp←topdp;
mem[head]←mem[inserts];
end;
comment Now the statistics-gathering and node-shuffling pass is complete,
so we wrap it up;
if page and dp>pagedepthmax then
begin ht←ht+dp-pagedepthmax; dp←pagedepthmax;
end;
p←getnode(boxnodesize);
mem[p]←(vlistnode lsh typed)+(mem[head] lsh valued);
if xpand then desiredheight←ht+desiredheight;
height(p)←desiredheight; width(p)←wd; depth(p)←dp;
delta←desiredheight-ht;
if delta≥0 and str>0.0 then glueset(p) ← delta/str
else if delta<0 and shr>0.0 then glueset(p) ← -1.0 max (delta/shr);
if delta<-shr-.1 and shr≥0.0 and tracing land 1 then
begin print(nextline,"Overfull box,",cvf(-delta-shr)," points too high:");
tracedump(p); print(nextline);
end;
if glueset(p)=0 and delta≠0 then glueset(p)←epsilon;
return(p);
end;
integer procedure hpack(integer p; real dw; integer xpand) # like hpackage,
but p is ptr not head;
begin mem[holdhead]←p; hpackage(holdhead,dw,xpand);
dsnodelist(mem[inserts]) # inserts are forgotten;
end;
integer procedure vpack(integer p; real dh; integer xpand) # like vpackage,
but p is ptr not head;
begin mem[holdhead]←p; vpackage(holdhead,dh,false,xpand);
end;
comment Spacing and adding to the current list: initsftable,append,finishdisplay;
comment The entries of sftable are used to decide how much stretchability
appears in spaces between words: The stretch component of glue is multiplied
by the "spacefactor" and the shrink component is divided by this factor,
determined as the last nonzero entry in the sequence
1.0 sftable[a] sftable[b] ... sftable[z]
if ab...z appears between consecutive spaces. The sf value of a box is 1.0,
the other sf values are set by the following procedure;
internal saf real array sftable[0:127] # spacefactor table;
internal procedure initsftable(real period,query,excl,colon,semi,comma);
begin arrclr(sftable,1.0);
sftable[")"]←sftable["'"]←sftable[""""]←sftable["]"]←0.0;
sftable["."]←period;
sftable["?"]←query;
sftable["!"]←excl;
sftable[":"]←colon;
sftable[";"]←semi;
sftable[","]←comma;
end;
simp integer procedure interlineglue(real delta; integer p);
begin comment returns a pointer to glue specification that makes up for
baseline distance deficiency of delta, when p points to the \baselineskip glue;
integer q;
if delta≥pagemem[lineskiplimitmem] then
begin comment The normal baseline spacing was not exceeded;
q←getnode(gluespecsize);
gluespace(q)←delta;
gluestretch(q)←gluestretch(p);
glueshrink(q)←glueshrink(p);
end
else begin q←eqlink(lineskip) # use lineskip glue if baseline
distance is already large;
mem[q]←mem[q]+refct1 # augment reference count;
end;
return(q);
end;
simp procedure append(integer b) # append a box node to the current list;
begin comment When appending boxes to an hlist, we simply adjust the links
and the spacefactor, but when appending to a vlist the inter-line glue
is also appended;
if abs(mode)=vmode and prevdepth xor pflag then
begin comment appending to a vlist with previous depth prevdepth;
integer p,q;
p←eqlink(baselineskip) # pointer to current baselineskip glue;
q←interlineglue(gluespace(p)-prevdepth-height(b),p);
getavail(p); mem[curnode]←mem[curnode]+p;
mem[p] ← (gluenode lsh typed) + (q lsh valued) + b;
end
else mem[curnode] ← mem[curnode] + b # in simple case, just append box b;
curnode ← b;
if abs(mode) = hmode then spacefactor←1.0 else prevdepth←depth(b);
end;
procedure finishdisplay(integer p);
begin comment This procedure takes the hlist p and appends it to the current
page as a displayed equation. The global variables eqnobox and abovedisplaywidth and
(hangbegin,hangwidth,hangfirst) are also used to construct an appropriate display.
We must be in vmode;
integer b # box containing the equation;
real w # width of the equation;
real dw # desired line width;
real nw # width of equation number to append to the equation;
real lmar # width of left indent;
real shift # amount to shift equation right for centering;
real qd # space for equation number plus quad width for principal mathsy font;
integer q1,q2 # pointers to glue spec for above and below;
if p=0 then return # ignore empty display (probably was $$\halign{...}$$);
b←hpack(p,0,1); w←width(b) # determine the equation's natural width;
dw←pagemem[hsizemem] # normal line width;
lmar←0.0;
if (hangbegin≤1 and not hangfirst) or (hangbegin>1 and hangfirst) then
begin comment adjust for indentation;
if hangwidth≥0 then lmar←hangwidth;
dw←dw-abs(hangwidth);
end;
if eqnobox then
begin nw←width(eqnobox); qd←mathpar(quad,textsize)+nw;
end
else nw←qd←0.0;
if w+qd>dw then
begin comment The equation doesn't fit with its natural width,
we will squeeze it as best we can;
if (w-shr)+qd≤dw then
begin comment It will fit on one line;
freenode(b,boxnodesize) # forget b and try again;
b←hpack(p,dw-qd,0); w←width(b);
end
else begin comment Too big, put equation number on separate line;
nw←0.0;
if w>dw then
begin freenode(b,boxnodesize) # forget b and try again;
b←hpack(p,dw,0); w←width(b);
end;
end;
end;
comment Now we have an equation b of width w and a possible equation number
eqnobox of width nw, and they are to be centered appropriately on a line of
width dw. (If eqnobox≠0 and nw=0, the equation number will appear on a separate
line by itself.);
shift←(dw-w)/2.0 # prepare to center the equation on the line;
if nw>0 and shift<2.0*nw then
begin comment Centering makes it too close to the equation number;
if type(value(b))=gluenode then
begin comment The user has specified glue at the beginning
of the formula, put it flush left or right;
shift←0.0;
end
else shift←(dw-nw-w)/2.0 # otherwise center in the remaining space;
end;
comment At this point shift will be negative if the equation is too large--
it will extend into the margins;
if shift+lmar≤abovedisplaywidth or (leqno and eqnobox) then
begin comment Without clearance at left, use dispskip glue above and below;
q1←eqlink(dispskip); q2←q1;
end
else begin comment otherwise use dispaskip,dispbskip and delete a virtual line;
hangbegin←hangbegin+1;q1←eqlink(dispaskip);q2←eqlink(dispbskip);
end;
if eqnobox and nw=0 and leqno then
begin comment Put left equation number on a separate line;
shiftamt(eqnobox)←lmar; append(eqnobox);
store((penaltynode lsh typed)+(infpen lsh valued)) #
"infinite" penalty prevents any break here;
end
else begin comment Otherwise put the chosen glue before the equation;
store((gluenode lsh typed)+(q1 lsh valued));
mem[q1]←mem[q1]+refct1 # adjust the reference count;
end;
if nw then
begin comment attach equation number; integer q;
getavail(q);
if leqno then
begin mem[q]←fillgluespec+b; mem[eqnobox]←mem[eqnobox]+q;
b←hpack(eqnobox,dw-shift,0); shift←0 # eqno will be left-justified;
end
else begin mem[q]←fillgluespec+eqnobox; mem[b]←mem[b]+q;
b←hpack(b,dw-shift,0) # eqno will be right-justified;
end;
end;
shiftamt(b)←shift+lmar;
append(b) # append the displayed formula to the page;
if eqnobox and nw=0 and leqno=0 then
begin comment Put right equation number on a separate line;
shiftamt(eqnobox)←lmar+dw-width(eqnobox);
store((penaltynode lsh typed)+(infpen lsh valued)) #
"infinite" penalty means that no break will occur here;
append(eqnobox);
end
else begin comment Otherwise we put the chosen glue after the equation;
if dpenalty then store((penaltynode lsh typed)+(dpenalty lsh valued));
store((gluenode lsh typed)+(q2 lsh valued));
mem[q2]←mem[q2]+refct1 # adjust the reference count;
end;
hangbegin←hangbegin-3 # treat as three lines output w.r.t. hanging indents;
end;
comment Hyphenation (word division) routines.
The following procedure is pretty much independent of the rest of TEX and
can be omitted on first reading;
internaldef excepsize=337,sufsize=116,prefsize=109,btabsize=30
# hyphenation table sizes;
internal saf integer array exceptable[0:excepsize-1]
# ordered hash table for exceptional words;
internal saf integer array excephyph[1:excepsize-1]
# corresponding hyphenation patterns;
internal saf integer array suffix[0:sufsize-1] # interpretive commands for suffixes;
internal saf integer array prefix[0:prefsize-1] # interpretive cmnds for prefixes;
internal saf integer array btable[2:btabsize+1] # consonant-pair exception table;
procedure hyphenate(integer p,n,dhyphen) # insert discretionary hyphens;
begin comment This procedure puts discretionary hyphen node of the specified
kind into the linked list of n ≥ 5 letters starting in mem[p]. (Kern nodes
might be between letters of this list.) The auxiliary tables for hyphenation
are built in TEXPRE.
This routine was developed jointly by D. E. Knuth and F. M. Liang;
integer u,q,r,b,c,h,i,j,t,pc;
integer finale # location of final "e" when the suffix routine starts
(temporarily set to 999999 if the suffix "ed" was just removed);
boolean firsttime;
label hashloop,phase2,sufbegin,interps,falsexx,marksuf,restarts,phase3,checkc,
restartp,interpp,marki,phase4c,vowelscan,phase4v,phase4vc,ertest,phase5,hashsearch;
comment People who don't like go to statements should not read this;
define o(c)=⊂"c" land '37⊃ # five-bit version of ascii character c;
u←getnode(n+2) # Get consecutive locations for convenient working back and forth;
q←p # prepare to store the given letters in the sequential list;
for i←u+1 thru u+n do
begin mem[i]←info(q) land '37 # store five bits of character;
q←link(q); if type(q)=kernnode then q←link(q);
end;
finale←1000000 # infinity;
comment The main part of this procedure (from now up to Phase 5) works entirely
in the sequential list just formed. Assuming that
mem[u]=0, mem[u+i]=a[i] for 1≤i≤n, mem[u+n+1]=0,
this procedure hyphenates the word a[1]...a[n] by setting mem[u+i]←0 when
a hyphen comes just before a[i], using TEX's hyphenation algorithm;
comment Phase 1. Search exception dictionary (an ordered hash table);
j← 7 min n;
hashsearch: t←mem[u+1];
for i←u+2 thru u+j do t←(t lsh 5)+mem[i];
h←t mod excepsize;
hashloop: while exceptable[h]>t do h←h-1;
if exceptable[h]≠t then
begin if h then
begin if j≠n or mem[u+n]≠o(s) then go to phase2;
j←j-1; go to hashsearch;
end;
h←excepsize-1; go to hashloop;
end;
comment Now the first 7 letters have been found in exceptable[h].
The corresponding hyphenation pattern appears in excephyph[h], but it
may be necessary to check more than seven letters to make sure the exception
applies. Additional letters to check appear at the righthand side of
excephyph[h], in a straightforward manner exhibited by the following code;
t←excephyph[h];
while t land '37 do
begin comment must check another letter;
j←j+1;
if mem[u+j]≠t land '37 then go to phase2;
t←t lsh -5;
end;
t←excephyph[h] land(flag ash(2-n)) # leftmost n-1 bits;
i←u+3;
while t do
begin if t<0 then mem[i]←0;
t←t lsh 1; i←i+1;
end;
go to phase5;
comment Phase 2. Interpretive routine for suffix removal.
The array suffix contains a "program" for a machine with the following
architecture. Instruction words have four fields, namely opcode, truex,
falsex, operand, each 9 bits. There are two registers: the program counter pc and
the character position i. There is also a toggle called firsttime.
Initially i=u+n-1, pc=mem[u+n], firsttime=true.
(Thus we begin by branching on the final character, mem[u+n].) The opcodes
are as follows, using t to stand for the operand field of the instruction:
scan. If mem[i]=t, decrease i by 1 and go to truex, else go to falsex.
double. Analogous, but tests if mem[i]=mem[i-1].
table. Analogous, but tests if mem[i]εsuffix[t], where xεy means that
word y shifted left x bits has a leading 1 bit.
check. Analogous, but tests if i>u+t and does not decrease i.
success. Sets mem[i+t+1]←0, stops.
fail. Stops.
repeat. Sets mem[i+t+1]←0, firsttime←false, i←i+t-1, pc←mem[i+1]. Thus,
the suffix routine is re-entered before the present suffix.*
again. If firsttime, sets firsttime←false, i←u+n-2, pc←mem[i+1]. Thus,
the suffix routine is re-entered with the final character omitted.*
Otherwise goes to truex.
mark. If t>0 or firsttime, sets mem[i+t+1]←0. Then goes to truex.
efail. (Special routine used to omit "ed".) If mem[u+n]="d" and
mem[u+n-1]="e", sets mem[u+n-1]←0, i←u+n-3, pc←mem[u+n-2]. Otherwise stops.
* Actually the suffix routine is reentered only when i≥u+3;
define opcodes=9,opcoded=27,truexs=9,truexd=18,falsexs=9,falsexd=9,oprands=9,
oprandd=0 # fields in interpreted instructions;
comment the above uses the fact that bitsperwd=36, much smaller fields would work;
define scan=0,double=1,table=2,check=3,success=4,fail=5,repeat=6,again=7,
mark=8,efail=9 # numeric equivalents of symbolic opcodes;
phase2: i←u+n-1; firsttime←true;
sufbegin: pc←mem[i+1]; if pc=o(e) then finale←i+1
else if finale=999999 then finale←i+2 else finale←1000000;
interps: case field(opcode,t←suffix[pc]) of begin
[scan] if(mem[i] xor t) land '37 then go to falsexx else i←i-1;
[double]if mem[i]≠mem[i-1] then go to falsexx else i←i-1;
[table] if(suffix[field(oprand,t)]lsh mem[i])≥0 then go to falsexx else i←i-1;
[check] if i≤u+field(oprand,t) then go to falsexx;
[success] begin mem[i+field(oprand,t)+1]←0; go to phase3 end;
[fail] go to phase3;
[repeat] begin i←i+field(oprand,t)-1; go to marksuf end;
[again] if firsttime then begin i←u+n-2; go to restarts end;
[mark] if (j←field(oprand,t)) or firsttime then mem[i+j+1]←0;
[efail] if mem[u+n]=o(d) and mem[u+n-1]=o(e) then
begin i←u+n-3; finale←999999; go to marksuf;
end
else go to phase3;
else confusion
end;
pc←field(truex,t); go to interps;
falsexx: pc←field(falsex,t); go to interps;
marksuf: mem[i+2]←0;
restarts: firsttime←false; if i≥u+3 then go to sufbegin;
comment Phase 3. Interpretive routine for prefix removal.
The array prefix contains a "program" for a machine with the following
architecture. Instruction words have four fields, namely opcode, truex,
falsex, operand, each 9 bits. There are two registers: the program counter pc and
the character position i. Initially i=u+2 and pc=mem[u+1].
(Thus we begin by branching on the first character, mem[u+1].) The opcodes
are as follows, using t to stand for the operand field of the instruction:
scan. If mem[i]=t, increase i by 1 and go to truex, else go to falsex.
repeat. Set i←i-t. If mem[i+1]=0, stop, otherwise set pc←mem[i],
mem[i]←0, i←i+1.
mark. If t>0 then set mem[i-t]←0. Also remember the value of mem[i],
for phase 4, then set mem[i]←0 (unless mem[i+1]=0) and stop.
table. If mem[i]ε(bit-pattern specified in truex,falsex,oprand fields)
then do a mark 0, otherwise just stop.
fail. Stop.
vow,cons. Stop.
Actually there are four flavors of stopping: One (vow) goes to phase 4 assuming
that mem[i-1] is a vowel, another (cons) goes to phase 4 with mem[i-1] ignored,
the third (fail) omits phase 4 entirely, the last (table when unsuccessful)
goes to phase 4 restarting at the beginning of the word;
define vow=success, cons=again # numeric versions of new opcodes;
phase3: pc←mem[u+1]; i←u+2;
restartp: c←pc; j←i-1;
interpp: case field(opcode,t←prefix[pc]) of begin
[scan]if(mem[i] xor t)land '37 then begin pc←field(falsex,t); go to interpp end
else begin i←i+1; pc←field(truex,t); go to interpp8 end;
[repeat] begin i←i-field(oprand,t)+1; if mem[i]=0 then go to phase5;
pc←mem[i-1]; mem[i-1]←0; go to restartp end;
[mark] begin if t←field(oprand,t) then mem[i-t]←0; go to marki end;
[table] if t lsh(mem[i]+opcodes)<0 then go to marki
else begin i←j; go to vowelscan end;
[fail] go to phase5;
[vow] go to phase4v;
[cons] go to phase4c;
else confusion
end;
comment Phase 4. This phase implements the consonant-pairs rule for middle
of words, as explained in the TEX writeup. Basically there are a few
special rules for double consonants and combining ch, gh, ph, sh, th into
single consonants, and then there are exceptional pairs of consonants between
which we will not break. There are two classes of exceptions, strong (like bl)
and weak (like ft). The necessary information is packed in btable, whose
words consist of three fields:
hchar specifies code for this character followed by letter h
weak specifies address of "weak" exception table for this character
leading 26 bits, give "strong"∨"weak" exception table
In order to keep hchar and weak to 3-bit fields, their values are encoded in
a straightforward manner that can be deduced by reading the following code;
define hchars=3,hchard=0,weaks=3,weakd=hchars # definition of btable fields;
marki: comment Now mark a permissible hyphen in mem[i] and do phase4 scanning;
if mem[i+1]=0 then go to phase5 # we don't allow only one letter between pref,suf;
if mem[i+1]=o(e) and mem[i+2]=o(d) and mem[i+3]=0 then go to phase5 # don't allow
syllable of form -<consonant>ed-;
c←mem[i]; mem[i]←0; go to vowelscan;
phase4c: c←mem[i];
vowelscan: comment We're looking for a vowel. Now c contains the letter
originally in mem[i], and suffix[0] is a table of vowels (including the null
code 0 as a vowel);
i←i+1; if(suffix[0] lsh c)≥0 then go to phase4c;
checkc: comment Now c is 0 if we've gone too far, else we've found a vowel;
if c=0 then go to phase5;
phase4v: b←mem[i]; i←i+1; if(suffix[0]lsh b)<0 then begin c←b;go to checkc;end;
comment Now b=mem[i-1] is a consonant following a vowel;
phase4vc: c←mem[i];
if b=o(q) and c=o(u) then begin i←i-1; go to marki end;
if(suffix[0] lsh c)<0 then begin i←i+1; go to checkc end;
if b=c then
begin comment double consonant;
if c≠o(l) and c≠o(s) then go to marki else
begin comment ll or ss, check for vowel;
if (c←mem[i+1])=0 then go to phase5;
if(suffix[0]lsh c)<0 then go to ertest;
i←i+2; go to phase4c;
end;
end
else if c=o(h) and j←field(hchar,btable[b]) then
begin comment change ch→e,gh→i,ph→o,sh→u,th→y;
b←b+j-2; i←i+1; go to phase4vc;
end
else if c=o(k) and b=o(c) then begin i←i+1; go to marki end;
if mem[i+1]=o(h) and j←field(hchar,btable[c]) then
begin comment change ch→e, etc., in second consonant position;
c←c+j-2; j←i+2;
end
else j←i+1 # Now j points to where we want a vowel;
if mem[j]=0 then go to phase5;
if(suffix[0] lsh mem[j])<0 then
begin comment vowel-consonant-consonant-vowel found;
if(btable[b] lsh (c-1))≥0 then go to marki # not an exception;
if(btable[field(weak,btable[b])+26] lsh(c-1))≥0 then
begin comment a strong exception;
i←j+1; go to phase4v;
end;
comment a weak exception; i←j-1;
if ((mem[i+1]=o(a) and mem[i+2]=o(g) and finale=i+3)
or (mem[i+1]=o(e) and mem[i+2]=o(s) and mem[i+3]=o(t)))
and mem[i+4]=0 then go to phase5 else go to ertest;
end;
comment three consonants in a row found;
i←j+1; go to phase4c;
ertest: if mem[i+1]=o(e) and mem[i+2]=o(r) and mem[i+3]=0
then go to phase5 else go to marki;
comment Phase 5. We're almost done! Although previous phases may have set mem[u+2]
or mem[u+n-1] or mem[u+n] to zero, we simply ignore this fact as we
output the answer;
phase5: q←link(p);
for i←u+3 thru u+n-2 do
begin if type(q)=kernnode then q←link(q);
comment if i=u+k, the variable q now points to a[k-1];
if mem[i] or (i+2≥finale and i≤finale) then q←link(q) else
begin getavail(r); t←link(q); mem[r]←dhyphen+t;
setlink(q,r); q←t;
end;
end;
freenode(u,n+2);
end;
comment The paragraph builder: hangwidth,hangbegin,justification,finishparagraph;
comment When a paragraph is initiated, the semantics routine begins to form
an hlist in hmode. Indentation at the beginning of the paragraph, if any,
is inserted explicitly into the list, as a box that has width but no
height or depth or associated list. Hanging indentation is controlled
by three global variables, "hanglength" and "hangbegin" and "hangfirst";
internal real hangwidth # amount to indent lines (negative if at right margin);
internal integer hangbegin # number of lines to wait before indentation changes;
internal boolean hangfirst # does hanging indent occur before hangbegin or not;
integer inhangbegin; boolean inhangfirst; real inhangwidth # for boxed paragraphs;
integer lines # number of lines output by justification procedure;
real lastwidth # width of final line output by justification procedure;
integer parshape # points to special shape specification;
comment If parshape ≠ 0, it overrides hanging indentation. In this case,
mem[parshape]=n, and (memreal(parshape+2i-1),memreal(parshape+2i)) are the
indentation and length of the first n lines. Subsequent lines use the specification
of line n;
comment The major computation associated with paragraph building is the
breaking of lines done by procedure "justification", which has thlowing
parameters:
real initwidth line width
integer linechange specifies k after which hanging indentation changes
real hangwidth if hangfirst, indentation on lines numbered ≤k
otherwise, indentation on lines numbered >k
boolean penlt true if final-widow penalty to be applied
(Note that if hangwidth is 0, the values of hangfirst and linechange don't matter.)
Procedure "justification" takes the hlist headed by temphead and appends it to
the current list. This procedure also computes the following two quantities:
integer lines the number of lines output
real lastwidth the width of the final line, including possible
hanging left indentation
(The displayed formula routine uses "lastwidth" to decide whether or not to
omit a line of blank space.)
The justification routine reads through the entire paragraph before deciding
the best places to break, since it is often better to make a slightly bad
break at the beginning of a paragraph to make things better later on. In
general, the algorithm essentially minimizes the sum of the squares of the
individual badness ratings (plus penalty points) subject to the condition that
no line has badness exceeding 100*jjpar and no hyphenations are needed. If there
is no way to break the paragraph subject to these conditions, the algorithm tries
again using jpar instead of jjpar and trying all possible hyphenations. To
do this it maintains a list of "break nodes" containing the following fields:
integer lineno number of lines so far, including one starting here
real width,gluestretch,glueshrink accumulated totals so far
integer curbrk points to place in hlist after which break occurs
real totbad accumulated sum of badness squares (times .0001)
integer prevbrk points to breaknode for best preceding break
Actually, the "lineno" field has subfields, the value is 8*lnum + 4*p + setting,
where lnum is the line number, setting is (0,1,2,3) for lines that are (shrunken,
normal, stretched, verystretched), and p is 1 if the break ends at a hyphen.
The reason is that all values of "lineno" need to be considered separately in the
optimization, in order to handle shapes and penalties properly.
The value in totbad is the minimum possible given a break at the stated position,
and the link in prevbrk tells how to achieve this minimum.
There are two lists of break nodes: The active list, beginning at mem[active],
consisting of all break nodes that are to be considered in future breaks, and the
inactive list, beginning at mem[inactive], consisting of all break nodes removed
from the active list. The active list is in order by lnum, except perhaps for
lines whose lnum is ≥ easyline, where easyline is a value such that the optimization
need not distinguish between such line numbers (they all have the same length).
Permissible breaks occur at glue nodes immediately following
anything but a rule, glue, penalty, eject, or "whatsit" node, provided that
such breaks have not been suppressed by hyphenation control nodes, and we can
also break at discretionary hyphens, penalty nodes, or eject nodes. In fact,
an eject node is forced to be a break, no matter how bad the result.
The horizontal list supplied to the justification routine always ends with
the two nodes "penalty 1000" and "parfillglue", and the final break is always
make after the final parfillglue.
Here's a sort of example of breaking:
abc defgh ijk lmnop qrst uvwx
yzab cdefghi jklmn opqr stu
Suppose jjpar=2, and suppose the line width is such that all breaks up to qrst have
badness exceeding 200, but to break after qrst or uvwx is feasible. Then two break
nodes will be created, one pointing to the glue following qrst and one pointing to
the glue following uvwx. (The pointer in curbrk is to a glue node when breaking
"before" the glue, but to a discretionary hyphen or penalty or eject node
otherwise. Suppose we have the sequence
a, b, \-, <glue>, c,
then to point at the discretionary hyphen (\-) means to break and to
include a hyphen there, but to point at the glue node after the \-
means to break after ab with no hyphen.) In the break node after qrst, the total
width, gluestretch, and glueshrink are computed up to the beginning of the
following line, not simply up to the point of break. Thus, if several consecutive
glue nodes will be eliminated by this break, their space and variability are
included in the totals, since these totals are used to compute the badness
of the following line (by subtracting the totals up to another attempted break).
Both break nodes for qrst and uvwx will have prevbrk pointing back to the
initial break node (which stands at the very beginning of the paragraph, and which
is initially the only active break). The initial break node becomes inactive
when the break after yzab discovers that the badness is infinite when the line
from beginning of paragraph to yzab is considered.
This routine was developed jointly by D. E. Knuth and M . F. Plass. The original
1977 version was substantially modified in 1980, based on accumulated experience;
internaldef prevbrk(p)=⊂mem[p+4]⊃ # break node for best previous break leading here;
internaldef lineno(p)=⊂mem[p+5]⊃ # state information for this break;
define lnum(p)=⊂lineno(p) lsh -3⊃ # serial number of line starting at this break;
internaldef curbrk(p)=⊂mem[p+6]⊃ # hlist position of this break;
internaldef totbad(p)=⊂memreal(p+7)⊃ # best sum of badness↑2 up to here;
internaldef breaknodesize=8 # number of words in a break node;
define infty = ⊂10.0↑30⊃ # a big number treated rather like infinity;
define shrunken=0, normal=1, stretched=2, verystretched=3 # characteristic of line;
real array lowestbadness[0:3]; integer array bestplace,bestline[0:3] # these
arrays are used to optimizing four cases that might be active;
comment The following global variables are not currently used by other routines
in TEX, but they are declared global anyway in case some extension wants to
refer to them;
internal boolean autobreaking # automatic line breaking not shut off by hyphnode;
internal real curwd,curst,cursh # current total width, stretch, and shrink;
JSTAT string diagnose # used in diagnostic typeouts;
JSTAT integer jn_2,jn_d;
JSTAT integer data_a,data_b,data_n,data_h;
JSTAT real jmean_a,jmean_b,jmean_n,jmean_h,jmean_s,jn_a,jn_s;
JSTAT real jvar_a,jvar_b,jvar_n,jvar_h,jvar_s;
JSTAT integer array jhist_s[-10:30];
internal procedure justification(real initwidth; integer linechange;
boolean hangfirst;
real hangwidth; boolean penlt) # routine to break hlists almost optimally;
begin real firstwidth,secondwidth # line lengths with hanging indents;
real firstindent,secondindent # line indentations with hanging indents;
real leastbadness # minimum of lowestbadness[0],...,lowestbadness[3];
integer easyline # smallest line number for which limited break nodes are OK;
integer q,p,prevp,n,t,ll,r,s;
integer bestbet; real bestscore,correction;
boolean notwarned # warning message has not been issued;
boolean secondpass # trying again with hyphenation;
real threshold # maximum badness/100 per line;
simp procedure trybreak(real penalt,w; boolean hyph) # decides if p might be a
reasonable place to break, and updates the break node table;
begin comment This procedure is called when p points to a permissible break
in an hlist, corresponding to an additional penalty as specified.
(The value of penalt is .01 times the value in TEX's writeup,
since there's really no need to multiply by 100 when computing badness scores.)
Parameter w is the current width to be used in badness calculations--it
differs from curwd if an inserted hyphen would appear at the break.
Parameter hyph is true if we are to regard this break as ending with a hyphen.
If this is a potentially useful break, new break nodes are created, as many as
needed for cases that must be optimized separately;
integer r,prevr,setting,l,oldl; real t,glue,badness,lwidth;
boolean no_break_yet; real newwidth,newstretch,newshrink;
JSTAT if xpar1 then print(nextline,diagnose,":");
JSTAT diagnose←"";
JSTAT data_b←data_b+1;
no_break_yet←true;
prevr←active;
oldl←0;
loop begin comment Look at all active break nodes to see if there are any that
lead to a badness≤threshold at the current position, and deactivate
break nodes that lead to infinite badness;
r←mem[prevr];
if r=0 or (l←lnum(r))>oldl then
begin comment insert new active nodes (preserving the fact that
the active list is in order by lnum when necessary);
if leastbadness<infty then
begin for setting←0 thru 3 do if lowestbadness[setting]<infty then
begin if lowestbadness[setting]≤leastbadness+adjpen/10000 then
begin integer q; comment we need a new break node;
if no_break_yet then
begin comment find width including glue after break;
integer s,t;
newwidth←curwd; newstretch←curst; newshrink←cursh;
s←p; while s do
begin case type(s) of begin
[gluenode] begin t←value(s);
newwidth←newwidth+gluespace(t);
newstretch←newstretch+gluestretch(t);
newshrink←newshrink+glueshrink(t) end;
[leadernode][penaltynode][discnode];
[kernnode] newwidth←newwidth+gluespace(s);
[ejectnode] if s≠p then done;
else done
end;
s←link(s);
end;
no_break_yet←false;
end;
q←getnode(breaknodesize);
width(q)←newwidth;
gluestretch(q)←newstretch; glueshrink(q)←newshrink;
prevbrk(q)←bestplace[setting];
lineno(q)←((((bestline[setting] + 1) lsh 1) + hyph) lsh 2)
+ setting;
curbrk(q)←p;
totbad(q)←lowestbadness[setting];
JSTAT if xpar1 then print(nextline," new break ",q,"→",prevbrk(q),
JSTAT ",",bestline[setting],"[",4*hyph+setting,"],",totbad(q));
JSTAT data_n←data_n+1;
mem[q]←r; mem[prevr]←q; prevr←q;
end;
lowestbadness[setting]←infty;
end;
leastbadness←infty;
end;
if r=0 then done;
if l<easyline then oldl←l else oldl←10000000;
comment Now compute the width of line l;
if parshape then
begin integer n; n←2*(mem[parshape] min l);
lwidth←memreal(parshape+n);
end
else if l>linechange then lwidth←secondwidth
else lwidth←firstwidth;
end;
JSTAT data_a←data_a+1;
comment Now compute the badness for a line starting at curbrk(r) and
ending with a break at the current position p (width w);
t←width(r)+lwidth # target width for line starting at break r;
if w>t then
begin glue←cursh-glueshrink(r);
if glue<0.0001 then glue←.0001;
if w>t+glue then badness←infty
else begin badness←(glue←(w-t)/glue)↑3;
if glue≥0.5 then setting←shrunken else setting←normal;
if badness>10.0↑6 then badness←10.0↑6 # badness is finite;
end;
end
else begin glue←curst-gluestretch(r);
if gluestretch(r)>1000000.0 and notwarned then
begin comment floating-point can't handle this;
error("Too much stretch for proper line breaking");
notwarned←false;
end;
if glue<0.0001 then glue←.0001;
badness←(glue←(t-w)/glue)↑3;
if glue<0.5 then setting←normal
else if glue<1.0 then setting←stretched else setting←verystretched;
if badness>10.0↑6 then badness←10.0↑6 # badness is finite;
end;
JSTAT if xpar1>3 then print(nextline," @",r," ⊃ ",badness);
if badness=infty or penalt=-infty then
begin comment break node r should become inactive;
mem[prevr]←mem[r]; mem[r]←mem[inactive]; mem[inactive]←r;
if secondpass and mem[active]=0 and leastbadness=infty then
begin comment On the second pass, we dare not lose all
activity. As a last resort, we allow an "overfull box"
with a finite penalty, causing consternation for the user;
badness←0.0; setting←shrunken # this will ensure
that some node has lowestbadness < infty;
end
else if badness>threshold then continue;
end
else begin prevr←r;
if badness>threshold then continue;
end;
comment Now we have found a feasible break;
if penalt≥0 then badness←(badness+penalt+.01)↑2
else if penalt>-infty then badness←(badness+.01)↑2-penalt↑2
else badness←(badness+.01)↑2 # -infty denotes a forced line break;
if hyph and (lineno(r) land 4) then badness←badness+penpen/10000
# additional penalty for two hyphens in a row, or in 2nd-last line;
if abs((lineno(r) land 3)-setting)>1 then badness←badness+adjpen/10000
# additional penalty for adjacent lines of very different settings;
comment at this point badness << infty;
badness←badness+totbad(r);
if badness<lowestbadness[setting] then
begin bestplace[setting]←r; bestline[setting]←l;
lowestbadness[setting]←badness;
if badness<leastbadness then leastbadness←badness;
end;
end;
end;
comment The justification procedure begins here;
JSTAT diagnose←"";
JSTAT data_a←data_b←data_n←data_h←0;
notwarned←true;
lowestbadness[0]←lowestbadness[1]←lowestbadness[2]←lowestbadness[3]←
leastbadness←infty;
if parshape then easyline←mem[parshape]
else begin if linechange<1000000 then easyline←linechange+1 else easyline←1;
firstwidth←initwidth; secondwidth←initwidth-abs(hangwidth);
firstindent←0; secondindent←hangwidth max 0;
if hangfirst then
begin firstwidth↔secondwidth; firstindent↔secondindent;
end;
end;
if loose then easyline←1000000 # when looseness is adjusted, no lines are "easy";
secondpass←false; threshold←jjpar;
loop begin comment This loop (the main pass) is done at most twice;
q←getnode(breaknodesize) # make a node representing break at the beginning;
mem[active]←q; mem[inactive]←0;
mem[q]←prevbrk(q)←0;
width(q)←gluestretch(q)←glueshrink(q)←totbad(q)←0.0;
lineno(q)←(1 lsh 3)+normal;
curbrk(q)←temphead;
p←mem[temphead];
curwd←curst←cursh←0.0; autobreaking←true;
prevp←p # prevp doesn't have to point to the node before p, it should only
point to a node such that if node p is a glue node the test below
for breaking at p is correct;
while p and mem[active] do
begin comment We go through the hlist calling trybreak at each
permissible break and keeping curwd, etc., up-to-date;
case type(p) of begin
[charnode] begin integer c; c←info(p);
JSTAT diagnose←diagnose&c;
curwd←curwd+charwd((c lsh -7),fontinfo[c]) end;
[hlistnode][vlistnode][rulenode] curwd←curwd+width(p);
[whatsitnode] justext(p);
[gluenode][leadernode] begin if autobreaking then
begin case type(prevp) of begin
[charnode][hlistnode][vlistnode][hyphnode][discnode]
[marknode][insnode] trybreak(0.0,curwd,0);
else begin comment do nothing; end
end;
end;
if type(p)=gluenode then begin
t←value(p);
curwd←curwd+gluespace(t);
curst←curst+gluestretch(t);
cursh←cursh+glueshrink(t);
if secondpass and autobreaking then
begin comment Check to see if possible hyphenation should be
tested, namely if the next nodes are lower case letters of
the same font, followed either by glue or by punctuation or
by a penalty node;
integer q;
if type(q←link(p))=charnode then
begin integer t,fa,fz,n;
t←ufield(info,mem[q]);
fa←t land((nfonts-1)lsh(infod+7))+("a" lsh infod)
# "a" in font;
fz←fa+(26 lsh infod) # just after "z" in font;
n←0 # n will be the number of letters passed;
comment Admissible nodes are kern nodes or lie in
the interval [fa,fz) including their
link field;
while q do
begin label next;
if mem[q]≥fz then
begin if type(q)≠kernnode then done;
go to next;
end
else if mem[q]<fa then
begin if uchyph then
begin comment uppercase OK;
integer f;
f←mem[q]+('40 lsh infod);
if f<fa or f≥fz then done;
end
else done;
end;
n←n+1;
next: q←link(q);
end;
if n≥5 and q and ((t←type(q))=gluenode
or (t=charnode
and sftable[(info(q)) land '177]≠1.0)
or t=penaltynode) then
begin comment try automatic hyphenation;
JSTAT data_h←data_h+1;
hyphenate(link(p),n,fa+((("-"-"a")lsh infod)
+(discnode lsh typed)));
end;
end;
end;
end end # end of the [gluenode] case;
[marknode][insnode];
[kernnode] begin if type(link(p))=gluenode and autobreaking then
trybreak(0,curwd,0); curwd←curwd+gluespace(p) end;
[hyphnode] autobreaking←ufield(value,mem[p]);
[penaltynode] begin short integer n; n←penalty(p);
if n<(1000 min infpen) then trybreak(n/100.0,curwd,0) end;
[discnode] begin t←value(p);
if t then
begin comment we must consider the width of the hyphen
that will be inserted if a break occurs here;
trybreak(hpen/100,curwd+charwd((t lsh -7),fontinfo[t]),1);
end
else trybreak(exhyph/100,curwd,1) end;
[ejectnode] begin if value(p)<2 then trybreak(-infty,curwd,0) end;
else confusion
end;
prevp←p; p←link(p);
end;
if p=0 then
begin
JSTAT diagnose←diagnose&"\par";
trybreak(-infty,curwd,1) # final linebreak;
if mem[active] then
begin comment We made it to the end of the list;
real lowbad;
q←mem[active]; lowbad←infty;
while q do
begin if totbad(q)<lowbad then
begin lowbad←totbad(q); bestbet←q;
end;
q←mem[q];
end;
ll←lnum(bestbet);
s←0;
if loose then
begin comment adjust to desired looseness;
q←mem[active];
while q do
begin integer l,d; l←lnum(q);
d←l-ll;
if (d<s and loose≤d) or (d>s and loose≥d) then
begin bestbet←q; s←d;
lowbad←totbad(q);
end
else if d=s and totbad(q)<lowbad then
begin lowbad←totbad(q); bestbet←q;
end;
q←mem[q];
end;
ll←ll+s;
end;
if secondpass or s=loose then done;
end;
end;
comment The first pass didn't succeed. If at first...;
JSTAT jn_2←jn_2+1;
q←mem[inactive]; while q do
begin p←mem[q]; freenode(q,breaknodesize); q←p;
end;
secondpass←true; threshold←jpar;
end;
ll←ll-1;
comment Now we have found the best sequence of breaks, namely to break into ll
lines, the last break coming at "bestbet" and the break nodes telling where
to break after that. The next step is to link up the break nodes in forward
order, using their (now redundant) totbad fields for this purpose;
define nextbrk(q)=⊂mem[q+7]⊃;
q←0;
while bestbet do
begin nextbrk(bestbet)←q;
q←bestbet; bestbet←prevbrk(q);
end;
comment During the finishing-up phase, which breaks up the hlist into packages
that go into the output vlist, q points to the break node specifying the end
of the current line, and temphead heads the hlist of nodes remaining to be output;
q←nextbrk(q); lines←0;
while mem[temphead] do
begin integer qq # the next break after this one;
qq←nextbrk(q);
r←curbrk(q);
if r then
begin if (t←type(r))=gluenode then
begin delgluelink(value(r));
setfield(value,mem[r],zeroglue) # glue break
becomes zero glue;
end
else if t=kernnode then gluespace(r)←0.0
else if t=discnode and value(r) then
mem[r]←mem[r]-((discnode-charnode)lsh typed)
# change discnode to charnode;
t←link(r); setlink(r,0);
end
else t←0 # t points to the rest of the hlist;
comment Now prune unwanted nodes at the break;
while t do
begin integer tt;
if t=curbrk(qq) then done # don't delete a chosen break;
case tt←type(t) of begin
[gluenode] delgluelink(value(t));
[kernnode][penaltynode][discnode];
[leadernode] dsnodelist(value(t));
else done
end;
r←link(t);
if tt=kernnode then freenode(t,kernnodesize)
else freeavail(t);
t←r;
end;
lines←lines+1;
comment Now set curwd and curst to the line width and indentation;
if parshape then
begin integer n; n←parshape+2*(mem[parshape] min lines);
curwd←memreal(n); curst←memreal(n-1);
end
else if lines≤linechange then
begin curwd←firstwidth; curst←firstindent;
end
else begin curwd←secondwidth; curst←secondindent;
end;
r←hpackage(temphead,curwd,0);
JSTAT if xpar2 then
JSTAT begin comment record statistical data on stretching/shrinking;
JSTAT integer s;
JSTAT real gs,ms;
JSTAT ms←(gs←glueset(r))-jmean_s;
JSTAT jn_s←jn_s+1.0;
JSTAT jmean_s←jmean_s+ms/jn_s;
JSTAT jvar_s←jvar_s+ms*(gs-jmean_s);
JSTAT s←gs*10+.5;
JSTAT if s>30 then s←30;
JSTAT jhist_s[s]←jhist_s[s]+1;
JSTAT end;
if ragged then glueset(r)←glueset(r)*(100.0/(100.0+ragged));
if lines=ll then
begin integer g; g←eqlink(parfillskip);
lastwidth←width(r)-gluespace(g)+curst;
if glueset(r)≥0 then
lastwidth←lastwidth-glueset(r)*gluestretch(g)
else lastwidth←lastwidth-glueset(r)*glueshrink(g);
end;
shiftamt(r)←curst;
append(r);
if mode>0 then
begin comment If being used by the page builder, insert the
topinsert, botinsert, and eject nodes removed from the line
by hpackaging, then check if there is any special penalty for
breaking after this line;
integer pen;
if mem[inserts] then
begin mem[curnode]←mem[curnode]+mem[inserts];
curnode←mem[inserts];
while link(curnode) do curnode←link(curnode);
end;
if (lines=1 and ll>1) or (penlt and lines=ll-1) then
pen←wpen
else pen←0;
if (lineno(q) land 4) and t then
begin comment This line ends with a hyphen or dash;
JSTAT jn_d←jn_d+1;
pen←pen+bpen;
end;
if pen then store((penaltynode lsh typed)+(pen lsh valued));
end
else begin dsnodelist(mem[inserts]);
JSTAT if (lineno(q) land 4) and t then jn_d←jn_d+1;
end;
mem[temphead]←t;
q←qq;
end;
JSTAT if xpar2 then
JSTAT begin comment record statistical data on justification efficiency;
JSTAT real data, delta;
JSTAT delta←(data←data_a)-jmean_a;
JSTAT jn_a←jn_a+1.0;
JSTAT jmean_a←jmean_a+delta/jn_a;
JSTAT jvar_a←jvar_a+delta*(data_a-jmean_a);
JSTAT delta←(data←data_b)-jmean_b;
JSTAT jmean_b←jmean_b+delta/jn_a;
JSTAT jvar_b←jvar_b+delta*(data_b-jmean_b);
JSTAT delta←(data←data_n)-jmean_n;
JSTAT jmean_n←jmean_n+delta/jn_a;
JSTAT jvar_n←jvar_n+delta*(data_n-jmean_n);
JSTAT delta←(data←data_h)-jmean_h;
JSTAT jmean_h←jmean_h+delta/jn_a;
JSTAT jvar_h←jvar_h+delta*(data_h-jmean_h);
JSTAT end;
comment Finally, free the list of break nodes;
q←mem[active]; while q do
begin p←mem[q]; freenode(q,breaknodesize); q←p;
end;
q←mem[inactive]; while q do
begin p←mem[q]; freenode(q,breaknodesize); q←p;
end;
end;
define infpenspec = ⊂((penaltynode lsh typed)+(infpen lsh valued))⊃;
define storepargluespec = ⊂begin integer pp; pp←eqlink(parfillskip);
store((gluenode lsh typed)+(pp lsh valued)); mem[pp]←mem[pp]+refct1 end⊃;
simp procedure finishparagraph(boolean penlt);
begin comment This procedure is invoked when the paragraph-so-far ends or
is followed by a displayed equation;
if type(curnode)=gluenode then
begin comment remove space at paragraph end and replace it by penalty;
delgluelink(value(curnode)); mem[curnode]←infpenspec;
end
else store(infpenspec) # append penalty 1000 to paragraph-so-far;
storepargluespec # append fill glue to paragraph-so-far;
mem[temphead]←mem[head] # get ready for justification;
popnest # return to vmode of the page builder;
justification(pagemem[hsizemem],hangbegin,hangfirst,hangwidth,penlt) # append
justified paragraph to the page contribution list;
end;
JSTAT procedure statistics(string title; JSTAT integer n; JSTAT real mean, var);
JSTAT begin setformat(0,0);
JSTAT print(nextline,"Statistics for ",title,": n=",n);
JSTAT setformat(15,8);
JSTAT print(" mean=",mean);
JSTAT if n>1 then print(" dev=",sqrt(var/(n-1)));
JSTAT end;
JSTAT procedure jstatout # prints statistics of justification routine;
JSTAT begin integer i,j,n;
JSTAT if ofilname then
JSTAT begin setprint("","N");
JSTAT setprint(ofilname[1 to ∞-3]&"JST","B");
JSTAT end;
JSTAT setformat(15,8);
JSTAT n←jn_a+.5;
JSTAT statistics("active nodes examined",n,jmean_a,jvar_a);
JSTAT statistics("breaks tried",n,jmean_b,jvar_b);
JSTAT statistics("break nodes created",n,jmean_n,jvar_n);
JSTAT statistics("hyphenations tried",n,jmean_h,jvar_h);
JSTAT setformat(0,0);
JSTAT print(nextline,"During ",n," paragraphs, second pass was used ",jn_2," times");
JSTAT n←jn_s+.5;
JSTAT print(nextline,"Among ",n," lines typeset, ",jn_d," ended with hyphens");
JSTAT statistics("glue stretch",n,jmean_s,jvar_s);
JSTAT print(nextline,"Histogram:");
JSTAT for i←-10 thru 30 do
JSTAT begin setformat(5,1);
JSTAT print(nextline,if i=30 then "≥ 3.0" else cvf(i/10));
JSTAT setformat(6,0);
JSTAT print(jhist_s[i]," ");
JSTAT if jhist_s[i] then for j←1 thru .5+100*jhist_s[i]/n do print("*");
JSTAT end;
JSTAT setformat(0,4);
JSTAT end;
comment Procedures for mmode: finishmlist,boxchar,compact,mathglue,varsymbol,
fractionrule,overbar,rebox,cleanbox;
integer procedure finishmlist(integer p);
begin comment This procedure is called when an mlist has been terminated by
a } or $ or \right. It completes an incomplete noad, pops the semantic stacks,
and returns a pointer that can be stored into a noad field if desired. Parameter
p is the right-delimiter noad if the mlist is terminated by \right, in which
case the corresponding left-delimiter noad appears at the beginning;
integer q;
if incompleatnoad then
begin subscr(incompleatnoad)←mem[head] lor fflag;
if p then
begin comment We need to move the left-delimiter node out;
q←field(link,supscr(incompleatnoad));
supscr(incompleatnoad)←link(q) lor fflag;
setlink(q,incompleatnoad);
mem[head]←q;
end
else mem[head]←incompleatnoad;
curnode←incompleatnoad;
end;
mem[curnode]←mem[curnode]+p # Trick: It isn't necessary to reset curnode if p≠0;
if head≠curnode then q←mem[head] lor fflag else q←0;
popnest; return(q);
end;
integer fount # font used by boxchar procedure;
integer procedure boxchar(integer c, style; boolean corr);
begin comment This procedure returns a pointer to a box containing the single
math character c, using the style parameter to govern its choice of fonts.
If corr is true, the box is made artificially wider by the italic correction
for c. The global variable fount is set to the number of the font actually used;
integer b,ch,q,w;
fount←mathfonttable(fontsize[style]+((c lsh -7) land 3));
ch←(c land '177)+(fount lsh 7); w←fontinfo[ch];
getavail(q); mem[q] ← ch lsh valued # q is a charnode;
b←getnode(boxnodesize); mem[b]←(hlistnode lsh typed)+(q lsh valued);
width(b)←charwd(fount,w);
if corr and (c land '600)≠'600 and field(ic,w) then
begin comment Put italic correction on box;
width(b)←width(b)+fmemreal(icbase[fount]+field(ic,w));
glueset(b)←epsilon # mark box nonstandard;
end;
height(b)←charht(fount,w); depth(b)←chardp(fount,w);
return(b);
end;
comment The boxchar procedure puts single characters into explicit boxes
for convenience in the mmode programs. Unfortunately this can consume a lot
of memory space, especially in a large table of numeric data, when there are
no italic corrections. Therefore the following straightforward procedures
are applied after a formula has been built;
forward recursive integer procedure compactlist(integer p);
recursive integer procedure compactbox(integer p);
begin comment The box pointed to by p is replaced by a single character box if
possible, and so are all subboxes with p;
integer r,c,f,w,t;
r←value(p); if r=0 then return(p);
if link(r)≠0 then
begin setfield(value,mem[p],compactlist(r)); return(p);
end;
if (t←type(r))=hlistnode or t=vlistnode then
begin setfield(value,mem[p],r←compactbox(r)); t←type(r);
end;
if glueset(p)≠0 or t≠charnode or shiftamt(p)≠0 then return(p);
comment The box contains a single unshifted character with glueset=0;
freenode(p,boxnodesize); return(r);
end;
recursive integer procedure compactlist(integer p);
begin comment All boxes in the hlist or vlist pointed to by p are compactboxed;
integer q ,r # pointers that run through the list, with q=link(r);
r←-1; q←p;
while q do
begin integer nextq,s,t; nextq←link(q);
if ((t←type(q))=hlistnode or t=vlistnode) and (s←compactbox(q))≠q then
begin setlink(s,nextq);
if r≥0 then setlink(r,s) else p←s;
q←s;
end;
r←q; q←nextq;
end;
return(p);
end;
real curquad # the quad width to be used in the mathglue procedure;
real curxspace # the math space parameter to be used in the mathglue procedure;
integer procedure mathglue(real x,y,z);
begin comment returns a pointer to a glue node specifying x*curquad, y*curquad,
z*curquad as its glue parameters;
integer p,g; getavail(g); p←getnode(gluespecsize);
mem[g]←(gluenode lsh typed)+(p lsh valued);
if curxspace then
begin comment Substituting a fixed amount of space (for typewriters);
integer m; if x>0 then m←x/curxspace+.999999 else m←x/curxspace;
gluespace(p)←curxspace*m; gluestretch(p)←glueshrink(p)←0.0;
end
else begin gluespace(p)←x*curquad;
gluestretch(p)←y*curquad; glueshrink(p)←z*curquad;
end;
return(g);
end;
integer procedure varsymbol(integer delimcode, style; real size);
begin comment This procedure returns a pointer to a box containing a symbol
of varying size, the smallest available symbol whose height+depth is greater than
or equal to the given size. The symbol must also be at least as large as the
symbols of the current style. If necessary, a large symbol will be constructed
from individual pieces. The parameter delimcode is an 18-bit delimiter
specification. If delimcode=0, the box will be empty and its width will be
2/3 of a thin space;
integer b,j,c1,c2,f,tag,uf,p,c,d,top,mid,bot,ext,curnode,n; real exth,s,axis;
label charfound, exit;
b←getnode(boxnodesize); p←-1 # b will be the final box, p the character if found;
c1←delimcode lsh -9; c2←delimcode land '777 # smaller and larger variants;
if c1≠0 then
begin comment try to find small variant that is large enough;
j ← fontsize[style] + ((c1 lsh -7) land 3);
while j≥0 do
begin f←mathfonttable(j);p←(c1 land '177)+(f lsh 7);
c←fontinfo[p]; if charht(f,c)+chardp(f,c)≥size then go to charfound;
j←j-4 # go to next larger size;
end;
end;
if c2=0 then go to charfound # p is best we can do although it wasn't big enough;
comment Now look for larger symbol in \mathex font;
if c2 land '600 ≠ '600 then
begin error("Large delimiter '"&cvos(c2)&" should be in mathex font");
go to charfound;
end;
f←mathfonttable(3); p←(c2 land '177)+(f lsh 7);
loop begin c←fontinfo[p];
tag←field(tg,c) # tag field;
d←field(rm,c) # "remainder" field of font info, points to next larger size;
if tag=tagvar then done # 0 means this character must be fabricated;
if tag=tagnone then go to charfound # there is no larger size;
if tag=taglig then
begin
error("Bad font link for large delimiter '"&cvos(c2));
p←-1;
go to charfound;
end;
if charht(f,c)+chardp(f,c)≥size then go to charfound;
p←(f lsh 7)+d # advance to next larger size;
end;
comment We will construct a variable-size symbol;
axis←mathpar(axisheight,fontsize[style]);
d←fmem[extbase[f]+d] # control codes for components of builtup symbol;
top←(d lsh -28) land '177; mid←(d lsh -20) land '177;
bot←(d lsh -12) land '177; ext←(d lsh -4) land '177;
uf←f lsh 7; ext←ext+uf;
s←0.0; exth←chardp(f,fontinfo[ext]) # exth is the allowable height increment;
comment Increase s to the appropriate final size;
if top≠0 then s←s+chardp(f,fontinfo[top←top+uf]);
if mid≠0 then s←s+chardp(f,fontinfo[mid←mid+uf]);
if bot≠0 then s←s+chardp(f,fontinfo[bot←bot+uf]);
n←0; while s<size do
begin n←n+1; s←s+exth;
if mid≠0 then s←s+exth # if there is a middle, need 2n extensions;
end;
comment Now fabricate the symbol as a vlist;
curnode←holdhead; mem[holdhead]←0;
if top≠0 then store(top lsh valued);
for j←1 thru n do store(ext lsh valued);
if mid≠0 then
begin store(mid lsh valued);
for j←1 thru n do store(ext lsh valued);
end;
if bot≠0 then store(bot lsh valued);
mem[b]←(vlistnode lsh typed)+(mem[holdhead] lsh valued);
height(b)←s/2+axis; depth(b)←s/2-axis; width(b)←charwd(f,fontinfo[ext]);
go to exit;
charfound: comment We have found character p in font f with fontinfo c.
Now we must box it and exit;
if p<0 then
begin mem[b]←hlistnode lsh typed;
width(b)←mathpar(quad,fontsize[style])/9.0;
glueset(b)←epsilon;
end
else begin getavail(d); mem[d]←p lsh valued # charnode;
height(b)←charht(f,c); width(b)←charwd(f,c); depth(b)←chardp(f,c);
mem[b]←(hlistnode lsh typed)+(d lsh valued);
end;
exit: return(b);
end;
integer procedure fractionrule(real desiredthickness);
begin comment yields a rulenode of the given thickness;
integer p; p←getnode(rulenodesize); mem[p]←rulenode lsh typed;
height(p)←desiredthickness;
width(p)←-100000.0 # width extends to boundary of containing vlist, depth is zero;
return(p);
end;
integer procedure overbar(integer p; real desiredheight, desiredthickness, clr);
begin comment yields a box consisting of box p with a vinculum placed overhead,
and a blank space (equal to clr) above that. The parameter
"desiredheight" indicates the top of the vinculum, not the top of the whole box;
integer b,q,r; q←fractionrule(desiredthickness);
getavail(r); b←getnode(boxnodesize);
height(b)←clr; mem[b]←(hlistnode lsh typed)+q;
mem[q]←mem[q]+r; mem[r]←fillgluespec+p;
return(vpack(b,desiredheight+clr,0));
end;
integer procedure rebox(integer p; real desiredwidth,offset);
begin comment changes box p into a box of width desiredwidth+offset,
centering it with lowerfillglue at each end but shifted right by the given offset.
(The reason for using lowerfillglue is so that (a) fillglue will still be
effective if centering was not really desired by the user, and (b) lowerfillglue
will also shrink so that the box can be made narrower than its natural width.
It is assumed that shiftamt(p)=0;
integer b,q1,q2,q3; real delta; delta←desiredwidth-width(p);
getavail(q1); getavail(q2); q3←getnode(boxnodesize); width(q3)←offset;
mem[q1]←lowerfillgluespec+q3;
mem[q2]←lowerfillgluespec;
if type(p)=hlistnode and glueset(p)=0 then
begin comment a nice box, unwrap it and add the new glue;
integer j; real str,shr;
str←2*gluestretch(lowerfillglue); shr←2*glueshrink(lowerfillglue);
b←value(p); setfield(value,mem[p],q1);
if b then
begin mem[q3]←(hlistnode lsh typed)+b;
comment We needn't bother to make glueset(q3)≠0;
loop begin comment recompute total stretch and shrink;
if type(b)=gluenode then
begin integer q; q←value(b);
str←str+gluestretch(q);shr←shr+glueshrink(q);
end;
if link(b)=0 then done;
b←link(b);
end;
mem[b]←mem[b]+q2 # attach the righthand lowerfillglue node;
end
else mem[q3]←(hlistnode lsh typed)+q2;
if delta≥0 then
begin if str>0 then glueset(p)←delta/str;
end
else if shr>0 then glueset(p)←delta/shr
else glueset(p)←epsilon;
width(p)←desiredwidth+offset; return(p);
end;
comment put box p into a larger box;
b←getnode(boxnodesize); mem[b]←(hlistnode lsh typed)+(q1 lsh valued);
height(b)←height(p); depth(b)←depth(p);
width(b)←desiredwidth+offset;
glueset(b)←delta/(2.0*gluestretch(lowerfillglue));
mem[q3]←(hlistnode lsh typed)+p; mem[p]←mem[p]+q2; return(b);
end;
integer procedure cleanbox(integer p);
begin comment makes sure that p points to a box with shiftamt(p)=0, given
that p is either 0 or a pointer to a box;
if p=0 then return(nullbox);
if shiftamt(p)=0 then return(p);
return(hpack(p,0,1));
end;
comment Major math mode procedures: mlist_to_hlist,evalmlist,boxfield;
preload_with
nospace, thinspace,opspace,thickspace, nospace, nospace, nospace,
thinspace, thinspace, 0, thickspace, nospace, nospace, nospace,
opspace, opspace, 0, 0, opspace, 0, 0,
thickspace,thickspace, 0, nospace, thickspace,nospace, nospace,
nospace, nospace, 0, nospace, nospace, nospace, nospace,
nospace, thinspace,opspace,thickspace, nospace, nospace, nospace,
thspace, thspace, 0, thickspace, thspace, thspace, thspace;
saf integer array spacetable[0:6,0:6] # table that governs inter-element
mlist spacing;
comment The indices into this table are respectively
box, op, bin, rel, open, close, punct;
integer procedure mlist_to_hlist(integer p, style; boolean penalties);
begin comment This procedure does most of the mathematics formatting: It converts
an mlist to an hlist, provided that the noads of the mlist contain no
references to other mlists. (The procedure "evalmlist" below makes it
possible to assume that this condition is satisfied.) If "penalties" is true,
penalty nodes that indicate permissible breaks in the main mlist will be inserted;
integer q # runs through the mlist;
integer curstyle # the style used at noad q;
integer cursize # fontsize[curstyle], the type size used at noad q;
integer r # the previous noad excluding nodenoads and stylenoads;
integer t # the type of the noad q;
integer rtype # the type of noad r;
real maxh # the maximum height so far of this mlist;
real maxd # the maximum depth so far of this mlist;
real kern # offset of limits to a displayed operator;
real drt # the default rule thickness;
real shiftup,shiftdown # baseline adjustments;
integer b,c,d # miscellaneous pointers;
integer curnode # most recent node on hlist being formed;
comment We make two passes over the mlist. On the first pass, boxes are
constructed for square roots and fractions, etc., and sub/superscripts are
attached. A few other minor operations are also done (e.g., binnoads are
changed to boxnoads if they don't appear in the context of binary operators,
and the height and depth are calculated so that left and right delimiters
of the appropriate size will be fabricated. The second pass gets rid of
all noads, and hooks together the desired hlist including appropriate
glue and penalty nodes;
if p=0 then return(0) # avoid degenerate case;
q←p; r←rtype←-1; maxh←maxd←0.0; drt←defaultrulethickness;
curstyle←style; cursize←fontsize[curstyle];
while q do
begin comment the first pass; label advanceq,donescripts,attachscript;
kern←0.0;
case t←type(q) of begin
[boxnoad] if value(q) and (r←operand(q)) then
begin if value(q)=1 then
begin comment \vcenter;
shiftamt(r)←
(height(r)-depth(r))/2-mathpar(axisheight,fontsize[curstyle]);
end
else begin comment \vtop; real h; integer p; p←value(r); h←0.0;
while p do case type(p) of begin
[charnode] begin integer t,c; t←fontinfo[c←info(p)];
h←charht((c lsh-7),t); done end;
[hlistnode][vlistnode][rulenode] begin h←height(p);done end;
[gluenode] done;
else p←link(p)
end;
shiftamt(r)←height(r)-h;
end;
end;
[opennoad];
[relnoad][closenoad][punctnoad] if rtype=binnoad then
mem[r]←mem[r] land ((1 lsh typed)-1) # convert binnoad to boxnoad;
[binnoad] if rtype=binnoad or rtype=opnoad or rtype=relnoad or
rtype=opennoad or rtype=punctnoad or rtype<0 then
mem[q]←mem[q] land ((1 lsh typed)-1) # convert binnoad to boxnoad;
[leftnoad][nodenoad] go to advanceq # leftnoad occurs only at left of mlist;
[rightnoad] begin if rtype=binnoad then mem[r]←
mem[r] land ((1 lsh typed)-1); go to advanceq end;
[stylenoad] begin integer s,g; curquad←mathpar(quad,cursize);
curxspace←mathpar(extraspace,cursize);
case s←value(q) of begin
[0][1][2][3][4][5][6][7] begin curstyle←s; cursize←fontsize[s];
go to advanceq end;
[thinspace] g←mathglue(1/6,0,0);
[thspace] if cursize=0 then g←mathglue(1/6,0,0) else g←0;
[thickspace] if cursize=0 then g←mathglue(5/18,5/18,0) else g←0;
[quadspace] g←mathglue(1.0,0,0);
[userspace] if cursize=0 then g←mathglue(2/9,1/9,2/9)
else g←mathglue(1/6,0,0);
[negthinspace] g←mathglue(-1/6,0,0);
[negthspace] if cursize=0 then g←mathglue(-1/6,0,0) else g←0;
[negthickspace] if cursize=0 then g←mathglue(-5/18,-5/18,0)
else g←0;
[negopspace] if cursize=0 then g←mathglue(-2/9,-1/9,-2/9) else g←0;
[opspace] if cursize=0 then g←mathglue(2/9,1/9,2/9) else g←0;
[mspace] begin integer qq,gg; qq←link(q); gg←value(value(qq));
g←mathglue(gluespace(gg)/18.0,gluestretch(gg)/18.0,
glueshrink(gg)/18.0); setlink(q,link(qq));
freeavail(qq); dsnodelist(gg) end;
else confusion end;
comment g is a glue node or 0, change this stylenoad to a nodenoad for g;
mem[q]←link(q)+(nodenoad lsh typed)+(g lsh valued);
go to advanceq end;
[sqrtnoad] begin integer b,r; real clr # extra blank space above operand;
b←cleanbox(operand(q));
if curstyle land 3 = 0 then clr←mathpar(xheight,cursize)/4+drt
else clr←1.25*drt;
r←varsymbol(radsign,curstyle,height(b)+depth(b)+clr+drt);
comment Now r points to a box containing a radical sign of sufficient
size (radsign is the delimiter code for radical signs). The upper left
corner of the corresponding rule should touch the upper right corner
of this box. We still need to raise or lower the box appropriately;
shiftamt(r)←(height(r)-depth(r)-height(b)+depth(b)-clr-drt)/2;
comment Now top of box minus drt equals height(b)+clr plus half the excess;
mem[r]←mem[r]+overbar(b,height(r)-shiftamt(r),drt,
if penalties then drt else 2*drt);
operand(q)←hpack(r,0,1); end;
[overnoad] begin b←cleanbox(operand(q));
operand(q)←overbar(b,height(b)+3*drt,drt,if penalties then drt
else 2*drt) end;
[undernoad] begin integer p,r,curnode; curnode←cleanbox(operand(q));
p←getnode(boxnodesize); operand(q)←p;
mem[p]←(vlistnode lsh typed)+(curnode lsh valued);
height(p)←height(curnode); width(p)←width(curnode);
depth(p)←depth(curnode)+5*drt;
if penalties then depth(p)←depth(p)-drt;
glueset(p)←2*drt/gluestretch(fillglue);
store(fillgluespec);
r←fractionrule(drt);
mem[curnode]←mem[curnode]+r end;
[abovenoad] begin real axis,s,delta,rt;
integer pn,pd,num,denom,ld,rd,p;
num←cleanbox(supscr(q)); denom←cleanbox(subscr(q)); rt←aboverule(q);
axis←mathpar(axisheight,cursize);
if curstyle land 3 = dispstyle then pn←pd←0 else
begin pd←1;if rt=0 then pn←2 else pn←1;
end;
shiftup←mathpar(num1+pn,cursize);
shiftdown←mathpar(denom1+pd,cursize);
comment Now axis is the distance from the base line to the center of the
bar line, while shiftup and shiftdown are the standard baseline
displacements for numerator and denominator in the current style.
These standard displacements will be increased, if necessary, to avoid
interference between numerator and denominator;
comment Center the numerator and denominator by reboxing the smaller one;
if width(denom)<width(num) then
denom←rebox(denom,width(num),0)
else if width(num)<width(denom) then
num←rebox(num,width(denom),0);
comment Compute actual baseline displacements;
if rt=0 then
begin comment the case of no fraction line;
real clr # minimum clearance desired between num and denom;
if curstyle land 3 = dispstyle then clr←7*drt else clr←3*drt;
if (delta←(depth(num)+height(denom)+clr)-(shiftup+shiftdown))
> 0 then
begin shiftup←shiftup+delta/2; shiftdown←shiftdown+delta/2;
end;
end
else begin comment the case of a fraction line;
real clr # minimum clearance desired between num, denom, and rule;
real delta1,delta2 # possible additions to shiftup, shiftdown;
if curstyle land 3 = dispstyle then clr←3*rt else clr←rt;
delta1←(depth(num)+clr+rt/2)-(shiftup-axis);
delta2←(height(denom)+clr+rt/2)-(shiftdown+axis);
if delta1>0 then
begin if delta2>0 then
begin comment both get minimum clearance;
shiftup←shiftup+delta1;
shiftdown←shiftdown+delta2;
end
else begin comment both get clearance of the good one;
shiftup←shiftup+delta1-delta2;
end;
end
else if delta2>0 then shiftdown←shiftdown+delta2-delta1;
end;
comment Make the vlist box for the fraction;
r←getnode(boxnodesize);
height(r)←height(num)+shiftup; depth(r)←depth(denom)+shiftdown;
width(r)←width(num) # this also equals width(denom);
getavail(p); mem[num]←mem[num]+p;
if rt=0 then
begin comment no rule inserted;
mem[p]←fillgluespec+denom;
glueset(r)←(shiftup+shiftdown-depth(num)-height(denom))/
gluestretch(fillglue);
end
else begin integer j; j←fractionrule(rt);
mem[p]←fillgluespec+j;
glueset(r)←(shiftup-depth(num)-rt/2-axis)/
gluestretch(fillglue);
getavail(p); mem[j]←mem[j]+p;
j←getnode(gluespecsize);
gluespace(j)←shiftdown+axis-height(denom)-rt/2;
mem[p]←(gluenode lsh typed)+(j lsh valued)+denom;
end;
comment Finally, put the fraction into a box with its delimiters;
s←mathpar(delim1+pd,cursize);
ld←varsymbol(ldelim(q),curstyle,s);
rd←varsymbol(rdelim(q),curstyle,s);
shiftamt(ld)←(height(ld)-depth(ld))/2-axis;
shiftamt(rd)←(height(rd)-depth(rd))/2-axis;
mem[ld]←mem[ld]+r; mem[r]←(vlistnode lsh typed)+(num lsh valued)+rd;
operand(q)←hpack(ld,0,1);
go to donescripts end;
[opnoad] begin integer b,m,p,upper,lower,f,c;
upper←supscr(q); lower←subscr(q) # upper and lower limits to operator;
if upper=0 and lower=0 then go to donescripts;
b←operand(q);if b=0 then b←nullbox;
comment Now set kern nonzero if the operator in box b is a single
character in the mathex font, having a nonzero ms field;
if field(type,m←mem[b])=hlistnode and field(link,c←mem[field(value,m)])=0
and (f←c lsh(-(7+links)))=mathfonttable(3) and
(m←field(ic,fontinfo[c lsh -links]))≠0 then kern←fmemreal(icbase[f]+m);
comment Did you get that?;
if curstyle land 3 = dispstyle then
begin comment putting limits on operator in display mode;
integer change,middle,r,g; real maxw; label exit;
change←mem[q] land (1 lsh valued) # should convention be changed?;
if kern≠0 then change←change xor (1 lsh valued);
if change then go to exit # limits to appear at right of operator;
comment limits to be centered above and below the operator
(except modified by kern, the upper limit being shifted
right and the lower limit shifted left by kern/2 each);
if upper then
begin upper←cleanbox(upper);
shiftup←(bigopspacing(3)-depth(upper))max(bigopspacing(1));
end
else begin upper←nullbox; shiftup←0;
end;
if lower then
begin lower←cleanbox(lower);
shiftdown←(bigopspacing(4)-height(lower))max
(bigopspacing(2));
end
else begin lower←nullbox; shiftdown←0;
end;
maxw←width(b)-kern;
if width(lower)>maxw then maxw←width(lower);
if width(upper)>maxw then maxw←width(upper);
upper←rebox(upper,maxw,kern);
middle←rebox(cleanbox(b),maxw,kern/2);
lower←rebox(lower,maxw,0);
b←getnode(boxnodesize);
width(b)←maxw+kern;
height(b)←height(middle)-shiftamt(middle)+depth(upper)+height(upper)
+(if shiftup then shiftup+bigopspacing(5) else 0);
depth(b)←depth(middle)+shiftamt(middle)+height(lower)+depth(lower)
+(if shiftdown then shiftdown+bigopspacing(5) else 0);
if shiftup=0 then mem[upper]←mem[upper]+middle else
begin getavail(r); mem[upper]←mem[upper]+r;
g←getnode(gluespecsize);gluespace(g)←shiftup;
mem[r]←(gluenode lsh typed)+(g lsh valued)+middle;
getavail(r);g←getnode(gluespecsize);
gluespace(g)←bigopspacing(5);
mem[r]←(gluenode lsh typed)+(g lsh valued)+upper;
upper←r;
end;
if shiftdown=0 then mem[middle]←mem[middle]+lower else
begin getavail(r); mem[middle]←mem[middle]+r;
g←getnode(gluespecsize);gluespace(g)←shiftdown;
mem[r]←(gluenode lsh typed)+(g lsh valued)+lower;
getavail(r);g←getnode(gluespecsize);
gluespace(g)←bigopspacing(5);
mem[r]←(gluenode lsh typed)+(g lsh valued);
mem[lower]←mem[lower]+r;
end;
mem[b]←(vlistnode lsh typed)+(upper lsh valued);
operand(q)←b; go to donescripts;
exit: end end;
[accentnoad] begin integer c,p,r,b; real h,t;
comment Slants are not taken into account in mathmode accents, since
the sizes of math characters are already adjusted for slant;
c←value(q) lsh -7;
p←boxchar(value(q),curstyle,false) # the accent character, in proper size;
b←cleanbox(operand(q));
getavail(r); mem[r]←lowerfillgluespec+b;
mem[p]←mem[p]+r # make a vlist from p to r to b;
shiftamt(p)←(width(b)-width(p))/2.0 # center the accent;
h←height(b); t←mathpar(xheight,cursize-2+c);
comment We will raise the accent by h-t;
width(p)←0 # the accent won't count in determining the new width;
operand(q)←vpack(p,height(p)+h-t,0); end;
else confusion
end;
comment Now we process the sub/superscripts of noad q;
b←operand(q);
if b≠0 and (t=opnoad or (c←value(b))=0 or link(c)≠0 or type(c)≠charnode or
shiftamt(b)≠0) then
begin comment the operand is not simply a character;
shiftup←height(b)-shiftamt(b)
-mathpar(supdrop,(c←fontsize[scrstyle[curstyle]]));
if shiftup<0 then shiftup←0;
shiftdown←depth(b)+shiftamt(b)+mathpar(subdrop,c);
if shiftdown<0 then shiftdown←0;
end
else shiftup←shiftdown←0.0;
comment shiftup and shiftdown are minimum amounts to shift baselines;
if supscr(q)=0 then
begin if subscr(q)=0 then go to donescripts;
comment subscript but no superscript;
d←cleanbox(subscr(q));
shiftdown←shiftdown max mathpar(sub1,cursize);
comment make sure that the subscript doesn't get above the baseline
plus four-fifths the xheight;
shiftdown←shiftdown max (height(d)-.8*(mathpar(xheight,cursize)));
shiftamt(d)←shiftdown;
if kern then
begin integer p,g # will contain glue of -kern;
getavail(p); g←getnode(gluespecsize);
mem[p]←(gluenode lsh typed)+(g lsh valued)+d;
gluespace(g)←-kern;
d←hpack(p,0,1);
end;
go to attachscript;
end;
shiftup←shiftup max mathpar(suptable[curstyle],cursize);
d←cleanbox(supscr(q));
comment make sure that the exponent doesn't get below the baseline plus
one-fourth the xheight;
shiftup←shiftup max(mathpar(xheight,cursize)/4+depth(d));
if subscr(q)=0 then
begin comment superscript but no subscript;
shiftamt(d)←-shiftup;
go to attachscript;
end;
comment both subscript and superscript;
shiftdown←shiftdown max mathpar(sub2,cursize);
c←cleanbox(subscr(q));
begin real delta; integer r;
if (delta←(depth(d)+height(c)+3*drt)-(shiftup+shiftdown))>0 then
begin comment lower subscript to ensure minimum clearance 3drt;
shiftdown←shiftdown+delta;
comment make sure that the exponent doesn't get below
the baseline plus 4/5 the x-height;
if (delta←.8*mathpar(xheight,cursize)+depth(d)-shiftup)>0 then
begin shiftup←shiftup+delta; shiftdown←shiftdown-delta;
end;
end;
getavail(r); mem[d]←mem[d]+r;
mem[r]←fillgluespec+c;
shiftamt(c)←-kern # kern might be set if t=opnoad;
d←vpack(d,shiftdown+shiftup+height(d),0); shiftamt(d)←shiftdown;
end;
attachscript: comment Now d points to a box representing the
sub/superscripts, and b=operand(q) is the box to attach it to;
if b=0 then operand(q)←d
else begin mem[b]←mem[b]+d; operand(q)←hpack(b,0,1);
end;
donescripts: if operand(q) then
begin b←operand(q); maxh←maxh max (height(b)-shiftamt(b));
maxd←maxd max (depth(b)+shiftamt(b));
end;
r←q; rtype←t;
advanceq: q←link(q);
end;
comment The second pass simply goes through and inserts the appropriate spacing,
returning the noads to free storage. It also handles leftnoads and rightnoads,
since we now know maxh and maxd;
q←p; rtype←-1; curstyle←style; cursize←fontsize[curstyle];
mem[temphead]←0; curnode←temphead;
define appnd(x)=⊂if x then begin mem[curnode]←mem[curnode]+x; curnode←x end⊃;
while q do
begin label advanceq; integer x;
integer s # size of noad to be returned to free storage;
integer pen # penalty for breaking after this noad;
integer qq # temporary pointer;
s←noadsize; pen←-1 # set default values;
case t←type(q) of begin
[binnoad] pen←mbpen lsh valued;
[relnoad] pen←mrpen lsh valued;
[boxnoad][opnoad][opennoad][closenoad][punctnoad];
[abovenoad] begin s←noadsize+2; t←boxnoad end;
[sqrtnoad][overnoad][undernoad][accentnoad] t←boxnoad;
[leftnoad][rightnoad] begin real axis,s,size;
axis←mathpar(axisheight,fontsize[style]);
s←(maxh-axis) max (maxd+axis) # maximum distance from axis;
t←t-(leftnoad-opennoad) # left→open,right→close;
size←(1.8*s) max (2*s-mathpar(xheight,fontsize[style]));
b←varsymbol(operand(q),curstyle,size);
shiftamt(b)←(height(b)-depth(b))/2-axis;
operand(q)←b end;
[nodenoad] begin s←1; x←value(q); if x=0 then go to advanceq;
if type(x)=discnode then
begin comment The font of a discretionary hyphen must be inserted;
integer c,f;
c←value(x) # 9-bit code for a math character;
f←mathfonttable(cursize+((c lsh -7) land 3));
setfield(value,mem[x],(f lsh 7)+(c land '177));
end;
appnd(x); go to advanceq end;
[stylenoad] begin s←1; curstyle←value(q); cursize←fontsize[curstyle];
go to advanceq end;
else confusion
end;
if rtype≥0 then
begin comment compute inter-element spacing;
integer g;
g←0; curquad←mathpar(quad,cursize);
curxspace←mathpar(extraspace,cursize);
case spacetable[rtype,t] of begin
[nospace];
[thinspace] g←mathglue(1/6,0,0);
[thspace] if cursize=0 then g←mathglue(1/6,0,0);
[thickspace] if cursize=0 then g←mathglue(5/18,5/18,0);
[opspace] if cursize=0 then g←mathglue(2/9,1/9,2/9);
else confusion
end;
appnd(g);
end;
appnd(operand(q));
if pen≥0 and penalties and((qq←link(q))=0 or
((type(qq)≠relnoad or type(q)≠relnoad) and
(type(qq)≠nodenoad or (qq←value(qq))=0 or type(qq)≠penaltynode))) then
begin comment In other words, if noad q is normally
to be followed by a penalty and if it is not a relnoad followed
by another relnoad and if it is not followed by an explicit
penalty specification, we do the following;
integer x; getavail(x); mem[x]←(penaltynode lsh typed)+pen;
appnd(x);
end;
rtype←t;
advanceq: r←link(q);
if s=1 then freeavail(q) else freenode(q,s);
q←r;
end;
return(mem[temphead]);
end;
forward recursive integer procedure boxfield(integer p,style;boolean c) # see below;
recursive integer procedure evalmlist(integer p, style; boolean penalties);
begin comment This procedure converts the general mlist pointed to by p
into an hlist, using the given style for the main mlist. The effect is
like mlist_to_hlist except that the given mlist may have sub-mlists, or it
might refer to math characters that aren't already in boxes. This is the
procedure that controls the implicit styles in math formulas. Recursion
occurs when evalmlist calls boxfield which calls evalmlist;
integer q,t,curstyle;
q←p; curstyle←style;
while q do
begin comment We must remove non-box fields from noad q;
label advanceq;
case type(q) of begin
[boxnoad][binnoad][relnoad][opennoad][closenoad][punctnoad][undernoad]
[accentnoad] operand(q)←boxfield(operand(q),curstyle,
supscr(q)≠0 or subscr(q)=0) # the latter parameter to boxfield
essentially makes a "kerned" symbol when there is a
subscript but no superscript, otherwise the italic correction
is included as the box is made;
[sqrtnoad][overnoad] operand(q)←boxfield(operand(q),undstyle[curstyle],
true);
[abovenoad] begin comment process numerator and denominator;
supscr(q)←boxfield(supscr(q),numstyle[curstyle],true);
subscr(q)←boxfield(subscr(q),denomstyle[curstyle],true); go to advanceq end;
[opnoad] begin comment check for a single character op in \mathex;
integer b,c; boolean singlchrxop;
if (c←operand(q) xor (flag lor '600))<'200 then
begin integer tag,d; singlchrxop←true;
if curstyle land 3=dispstyle and
(tag←field(tg,d←fontinfo[(mathfonttable(3) lsh 7)+c]))=taglist then
operand(q)←(operand(q) land (lnot '177))+field(rm,d) # use larger size if available;
end
else singlchrxop←false;
b←operand(q)←boxfield(operand(q),curstyle,true);
if singlchrxop then
begin comment Shift the character so that its height above the axis
exceeds its depth below the axis by the character height;
shiftamt(b)←-mathpar(axisheight,fontsize[curstyle])-.5*depth(b);
end;
end;
[stylenoad] begin integer v; if (v←value(q))<8 then curstyle←v;
go to advanceq end;
[leftnoad][rightnoad][nodenoad] go to advanceq;
else confusion end;
t←boxfield(supscr(q),scrstyle[curstyle],true);
supscr(q)←t;
if t then
begin comment add 1mu to the width of the superscript;
width(t)←width(t)+mathpar(quad,fontsize[scrstyle[curstyle]])/18.0;
end;
t←boxfield(subscr(q),undstyle[scrstyle[curstyle]],true);
subscr(q)←t;
if t then
begin comment add 1mu to the width of the subscript;
width(t)←width(t)+mathpar(quad,fontsize[scrstyle[curstyle]])/18.0;
end;
advanceq: q←link(q);
end;
return(mlist_to_hlist(p,style,penalties));
end;
recursive integer procedure boxfield(integer p, style; boolean corr);
begin comment This procedure converts a noad field into the corresponding box.
If corr is true, the italic correction occurs at the right of a single-character
box. Recursion comes about when boxfield calls evalmlist which calls boxfield;
if p≥0 then return(p) # nothing to do if already boxed;
if p land (1 rot -2) then
begin comment p denotes a sub-mlist that should be boxed;
integer b,t; b←evalmlist(field(link,p),style,false);
if link(b)=0 then return(b) # this happens in particular if b=0;
return(hpack(b,0,1));
end;
comment p denotes a single character that should be boxed;
return(boxchar(p land '777, style, corr));
end;
comment Data structures for \halign and \valign: alignlist,alignrecord;
comment A separate group of stacks (also maintained with convention #1) is used to
tell what should be done when ⊗ and \cr occur in the input;
internaldef alignsize=4 # max number of simultaneous alignments;
internal saf integer array algnlststack[0:alignsize-1];
internal integer alignlist # points to beginning of alignment record list;
internal saf integer array algnrcrdstack[0:alignsize-1];
internal integer alignrecord # points to alignment record in the list;
internal saf integer array algnststack[0:alignsize-1];
internal integer alignstate # if zero, getnext should interrupt ⊗ and \cr tokens;
internal integer alignptr # stack pointer for alignments;
comment To help understand the way alignment works, consider the example input
\halign to <length>{u1#v1 ⊗ u2#v2 ⊗ u3#v3 ⊗ u4#v4\cr
\noalign {\hrule}
\noalign {\hbox to size{...}}
x11⊗x12⊗x13\cr
x21\cr
\noalign {\vfill}
x31⊗x32⊗x33\cr}
Here's what happens: The desired final <length> is placed on savestack.
A list of five alignment records is created, pointed to by alignlist. The
first record on that list contains a pointer to the tabskip glue that is
to be used at the left of aligned lines, and the other four records
contain pointers to uj,vj, and the tabskip glue to be used after column j.
The other four records also contain a "maxsofar" field that will record
the maximum natural width of the uj xij vj hlists;
define alignrecordsize=5 # number of words in alignment record (first word is link);
define listu(p)=⊂mem[p+1]⊃ # uj token list in an alignment;
define listv(p)=⊂mem[p+2]⊃ # vj token list in an alignment;
define maxsofar(p)=⊂memreal(p+3)⊃ # maximum width or height so far;
define tabglue(p)=⊂mem[p+4]⊃ # pointer to tabskip glue;
comment After the \noalign's are bypassed (they simply go onto the current vlist
being built), the fact that x11 doesn't start with "\noalign" causes the
startalignbox procedure to be invoked. This switches to -hmode and prepares
to build an hlist of "unset" boxes. Procedure startunsetnode goes into a
still deeper level of -hmode, sets the scanner to emit the tokenlist u1 and then
to make alignstate zero. The scanner will increase alignstate by 1 for each { and
decrease it by 1 for each }, and it checks for ⊗ or \cr when alignstate is zero.
When x11 and the ⊗ have been scanned, alignstate is made infinitely negative,
and procedure aligndelim uses the setting of alignrecord
to cause the scanner emit the tokenlist v1. The end of this tokenlist is signalled
by the command "endv", which should occur at a "stable" time. Now endv stimulates
procedure finishunsetnode to package up the hlist corresponding to u1 x11 v1.
After alignrecord is advanced, the same thing happens to u2 x12 v2, and then to
u3 x13 v3. Now that \cr occurred instead of ⊗, the value of alignrecord is
set negative-- the next endv will notice this negativity and will invoke
procedure finishalignbox, causing this list of unset nodes to be packaged.
At this point maxsofar has been set to the width of uj x1j vj for j = 1,2,3, but
it remains 0.0 for j=4. By the time we reach the end of the alignment,
the maxsofar entries will tell how wide the unset nodes should be. However,
we already know the correct height and depth of the boxes containing unset nodes.
Now that the first line has been aligned, alignrecord is "rewound" back to the
beginning of the alignment record list, and the same process repeats again.
Finally after "\cr}" the procedure endalign is called. It goes thru the
vlist looking for boxes containing unset nodes, and repackages them to the
desired widths.
Note that the processing of \halign involves giving up control to most of the
rest of TEX, with occasional bits and pieces of activity at critical junctures.
One of the most critical of these junctures is the label "aligntest" in the
main control routine.
The alignment procedures are unaffected by the setting of hangbegin. (If a
hanging indent were to terminate in the middle of an alignment, it isn't
clear what should be done, so TEX simply sidesteps the problem.);
comment Alignment procedures: (init|end)align,(start|finish)(alignbox|unsetnode);
procedure initalign # beginning an \halign or \valign;
begin comment This procedure is called when \halign or \valign has been
scanned in an appropriate mode. Its function is to scan the preamble and to
set up the alignlist records that control subsequent steps in the
alignment process;
integer p,q,itm,atype;
define storeitem=⊂begin p←q; getavail(q); mem[p]←(itm lsh infod)+q;end⊃
# stores previous item and makes it point to current one;
atype←hashentry # halign or valign;
if alignptr≥alignsize then overflow(alignsize);
algnlststack[alignptr]←alignlist;
algnrcrdstack[alignptr]←alignrecord;
algnststack[alignptr]←alignstate;
alignptr←alignptr+1 # push down the alignment stacks;
pushnest;
if mode=mmode then
begin mode←-vmode; prevdepth←auxstack[nestptr-2];
end
else begin mode←-abs(mode) # go into a restricted mode;
if mode=-hmode then spacefactor←1.0 # else prevdepth stays what it was;
end;
comment Now mode is -vmode for \halign and -hmode for \valign;
mode←(-hmode-vmode)-mode # temporary switch of modes for the benefit of scanspec;
scanspec # put box size specification and justification code on savestack;
mode←(-hmode-vmode)-mode # restore true mode;
newsavelevel(aligncode) # This guards against extra }'s in the alignment;
alignlist←getnode(alignrecordsize); alignrecord←alignlist;
alignstate←-1000; curcmd←lbrace;
pagewarning←"preamble of"; warnindex←atype;
loop begin comment Remember the current tabskip glue;
q←eqlink(tabskip); mem[q]←mem[q]+refct1; tabglue(alignrecord)←q;
if curcmd=carret then done # \cr sensed;
mem[alignrecord]←getnode(alignrecordsize); alignrecord←mem[alignrecord];
listv(alignrecord)←-1;
comment Now scan uj#vj;
q←holdhead; itm←0;
loop begin gettok;
while curcmd=assignglue and curchar=tabskiploc do
begin integer p; p←scanglue;
pagewarning←"preamble of"; warnindex←atype;
eqdefine(tabskiploc,glueref,p); gettok;
end;
comment The above might be called "get non-tabskip token";
if curcmd=tabmrk or curcmd=carret then
begin backerror("Missing # inserted in alignment preamble");
done;
end;
if curcmd=macprm then done;
storeitem; itm←curtok;
end;
mem[q]←itm lsh infod # store last item of uj tokenlist;
listu(alignrecord)←mem[holdhead] # store pointer to the tokenlist;
q←holdhead; itm←0 # Now start again;
loop begin gettok;
while curcmd=assignglue and curchar=tabskiploc do
begin integer p; p←scanglue;
eqdefine(tabskiploc,glueref,p); gettok;
end;
if (curcmd=tabmrk or curcmd=carret) and alignstate=-1000 then done;
if curcmd=macprm then
begin error("Only one # allowed per tab");
continue;
end;
storeitem; itm←curtok;
end;
storeitem;
mem[q]←endv lsh (cmdd+infod) # append endv command to vj;
listv(alignrecord)←mem[holdhead] # store pointer to vj tokenlist;
maxsofar(alignrecord)←0.0;
end;
pagewarning←null;
end;
simp procedure startalignbox;
begin comment We are beginning a new hlist or vlist to be haligned or valigned,
having just scanned a \cr;
pushnest; mode←(-hmode-vmode)-mode;
if abs(mode)=hmode then spacefactor←1.0 else prevdepth←pflag;
alignrecord←mem[alignlist] # "rewind" to point to u1,v1;
end;
simp procedure startunsetnode;
begin comment We are beginning a new tab position to be haligned or valigned;
pushnest;
if mode=-hmode then spacefactor←1.0 else prevdepth←pflag;
pushinput; state←tokenlist;
if alignrecord<0 then mustquit;
loc←listu(alignrecord); recovery←-((2 lsh infod)+loc) # insert uj into the input;
comment The getnext routine will turn alignstate zero when uj is exhausted,
and when the 0-level ⊗ or \cr appears it will call the aligndelim procedure below;
end;
internal procedure aligndelim # do this when ⊗ or \cr is scanned;
begin if alignrecord<0 or listv(alignrecord)<0 then mustquit;
if curcmd=tabmrk and mem[alignrecord]=0 then error("Extra alignment tab")
else begin comment Now we insert the current vlist into the input. When it is
completed, endv will occur and finishunsetnode will be invoked;
alignstate←-1000;
pushinput; state←tokenlist; loc←listv(alignrecord);
recovery←-((1 lsh infod)+loc);
if curcmd=carret then alignrecord←-alignrecord;
end;
end;
procedure finishunsetnode;
begin comment The hlist or vlist just formed is to be packaged into a box
whose glue parameter will be set later. This box is appended to the list of
such boxes that is being maintained on the next lower level of nesting;
integer p,q;
q←abs(alignrecord) # alignrecord will have been negated if \cr was sensed;
if mode=-hmode then
begin p←hpackage(head,0,1);
dsnodelist(mem[inserts]);
if width(p)>maxsofar(q) then maxsofar(q)←width(p);
mem[p]←mem[p]+((unsetnode-hlistnode) lsh typed) # change to unset node;
end
else begin p←vpackage(head,0,false,1);
if height(p)+depth(p)>maxsofar(q) then maxsofar(q)←height(p)+depth(p);
mem[p]←mem[p]+((unsetnode-vlistnode) lsh typed) # change to unset node;
end;
if str>0 then glueset(p)←str # save the amount of glue stretch;
popnest;
mem[curnode]←mem[curnode]+p; curnode←p;
end;
simp procedure finishalignbox # packages a list of unset nodes;
begin comment The hlist or vlist just formed consists entirely of unset boxes
that will be set when the current alignment is completed;
integer p;
if mode=-hmode then
begin p←hpackage(head,0,1); dsnodelist(mem[inserts]);
end
else p←vpackage(head,0,false,1);
popnest;
append(p);
end;
procedure endalign # ending an \halign or \valign;
begin comment This procedure is called when the end of an alignment
(e.g., \cr}) has been scanned;
integer p,prevp,pp,q,qq,c; real len;
curlev←curlev-level1;
saveptr←saveptr-3 # Now savestack is returned to its state before the
\halign or \valign, and savestack[saveptr] contains the box size spec
and savestack[saveptr+1] contains the justification code
(the endv routine has ensured this);
len←memory[location(savestack[saveptr]),real];
c←savestack[saveptr+1];
prevp←head; p←mem[prevp] # p will run through the current vlist or hlist,
looking for boxes composed of unset nodes;
while p do
begin if(type(p)=hlistnode or type(p)=vlistnode)
and (pp←value(p)) and type(pp)=unsetnode
then begin alignrecord←alignlist;
q←holdhead; mem[holdhead]←0 # q will be used to construct new list;
loop begin integer g,s; getavail(s);
g←tabglue(alignrecord); mem[g]←mem[g]+refct1;
mem[q]←mem[q]+s; q←s;
mem[q]←(gluenode lsh typed)+(g lsh valued);
alignrecord←mem[alignrecord];
if alignrecord=0 then done;
if pp then
begin real l;
if mode=-vmode then
begin comment element of \halign;
l←width(pp);
width(pp)←maxsofar(alignrecord);
height(pp)←height(p); depth(pp)←depth(p);
mem[pp]←mem[pp]-
((unsetnode-hlistnode)lsh typed);
end
else begin comment element of \valign;
l←height(pp)+depth(pp);
height(pp)←maxsofar(alignrecord)-depth(pp);
width(pp)←width(p);
mem[pp]←mem[pp]-
((unsetnode-vlistnode)lsh typed);
end;
if glueset(pp) then glueset(pp)←
(maxsofar(alignrecord)-l)/glueset(pp);
qq←pp; pp←link(pp); setlink(qq,0);
end
else begin comment This tab position was omitted;
qq←getnode(boxnodesize) # prepare for empty box;
if mode=-vmode then
begin mem[qq]←hlistnode lsh typed;
width(qq)←maxsofar(alignrecord);
comment We needn't make glueset(qq)≠0;
end
else begin mem[qq]←vlistnode lsh typed;
height(qq)←maxsofar(alignrecord);
comment We needn't made glueset(qq)≠0;
end;
end;
mem[q]←mem[q]+qq; q←qq;
end;
comment Now mem[holdhead] points to the aligned list;
if mode=-vmode then
begin pp←hpackage(holdhead,len,c);
dsnodelist(mem[inserts]);
end
else pp←vpackage(holdhead,len,false,c);
setlink(prevp,pp);q←p;p←link(p);freenode(q,boxnodesize);
mem[pp]←mem[pp]+p; prevp←pp;
end
else begin prevp←p; p←link(p);
end;
end;
alignrecord←alignlist;
loop begin delgluelink(tabglue(alignrecord));
dslist(listu(alignrecord)); dslist(listv(alignrecord)) # free storage;
q←mem[alignrecord]; freenode(alignrecord,alignrecordsize);
if q=0 then done else alignrecord←q;
end;
auxstack[nestptr-1]←aux; p←mem[head];
popnest;
if mode=mmode then
begin comment end of \halign in display mode inserts dispskip glue;
integer q,r,s;
getavail(r); getavail(s); q←eqlink(dispskip);
mem[q]←mem[q]+2*refct1 # increase reference count;
mem[r]←(gluenode lsh typed)+(q lsh valued)+p;
mem[prevp]←mem[prevp]+s;
mem[s]←(gluenode lsh typed)+(q lsh valued);
contrib←r;
curndstack[nestptr-1]←s # curnode of the page builder;
auxstack[nestptr-1]←aux # prevdepth of the page builder;
incompleatnoad←0;
end
else begin comment otherwise simply append to the current list;
mem[curnode]←mem[curnode]+p; curnode←prevp;
end;
alignptr←alignptr-1 # now pop up the alignment stacks;
alignstate←algnststack[alignptr];
alignrecord←algnrcrdstack[alignptr];
alignlist←algnlststack[alignptr];
end;
comment Beginning of the main procedure: maincontrol;
internal procedure maincontrol # governs all the activities;
begin comment This procedure contains the master switch that causes
all the various pieces of TEX to do their things in the right order --
unless the user's input contains unexpected strangenesses. We have
here the grand climax of the program, the applications of all the tools
that have been so laboriously constructed. And it's also the messiest part
of the program, in the sense that it necessarily refers to other
pieces of code all over the place;
label bigswitch # go here in order to get next input token and then carry
out the corresponding command, based on the current mode;
label reswitch # same as bigswitch but using the current input token;
label fallthru # go here when an invalid command appears in the input;
label missingfont # go here when we must stop because no font was defined;
label missingbrace # go here when unsave produced an unexpected incomplete block;
label extrarb # go here when extra right bracket found;
label addtopage # attaches page contribution list to the current page;
label ejectpage # break a page in the best known place and invoke output routine;
label endoutput # go here at end of output routine;
label endpageout # output a page that's really completed;
label aligntest # go here after the \cr in alignments;
label scanbox # scan a box including the first token;
label beginbox # scan a box not including the first token;
label justbox # go here when done building a list for a box;
label boxend # go here when done building a box;
label topbotinsend # go here at end of topinsert or botinsert;
label simpleappend # go here to put one-word item onto current list;
label scanmathend # go here to finish scanning a box in math mode;
label mathchar # go here to append a math character to an mlist;
label addtomlist # go here to append a noad to an mlist;
label makemathbox # go here to complete a box noad;
label scanmath # go here to scan a character or {...} in math mode;
label outputonly # go here after illegal use of operation outside \output routine;
integer d # index variable;
integer curbox # recently built box;
integer curnoad # recently built noad;
integer curitem # one-word item to be stored;
integer curins # insertion spec for current contribution to page;
integer deadcycles # number of times output routine has yielded null box;
DEBUGONLY integer checkingmem # trying to find where memory dies;
define checkpriv = ⊂if mode<0 then go to fallthru⊃
# checks if we're currently in a privileged mode;
comment The first thing this procedure must do is initialize the semantic stacks;
nestptr←0; mode←vmode # page builder in control;
mem[pagehead]←mem[contribhead]←mem[waitinghead]←0;
pagetail←pagehead; curnode←contribhead; waitingtail←waitinghead # lists empty;
emptypage←2; finaleject←false;
head←contribhead;
prevdepth←pflag;
alignptr←alignlist←alignrecord←0;alignstate←-1000;
outputdormant←true;
hangbegin←1000000;hangfirst←false;parshape←0;
deadcycles←0;
topmark←firstmark←botmark←0;
dimmode←0;
DEBUGONLY checkingmem←0;
JSTAT jn_2←jn_d←0;
JSTAT jmean_a←jmean_b←jmean_n←jmean_h←jmean_s←jn_a←jn_s←0.0;
JSTAT jvar_a←jvar_b←jvar_n←jvar_h←jvar_s←0.0;
JSTAT arrclr(jhist_s);
bigswitch: getnext;
DEBUGONLY if checkingmem then checkmem(false);
reswitch: case abs(mode)+curcmd of begin
comment For each valid combination of mode and cmd the following cases show
what to do and where to go next. Invalid combinations will fall through to the
end of this long case statement, where label "fallthru" appears;
[vmode+0][hmode+0][mmode+0] begin error("Undefined control sequence");
go to bigswitch end;
[vmode+lbrace][hmode+lbrace] begin newsavelevel(simpleblock);
go to bigswitch end # ordinary "{" simply affects the block structure but
not the mode or the current list;
[mmode+lbrace] begin newsavelevel(mathblock);
comment See also label scanmath for another kind of block in math mode;
pushnest; incompleatnoad←0 # begin to form sub-mlist;
go to bigswitch end;
[vmode+rbrace][hmode+rbrace][mmode+rbrace] begin comment Now we clear the
top levels of the savestack and branch to the appropriate routine;
inhangbegin←innerhangbegin;inhangfirst←innerhangfirst;inhangwidth←innerhangwidth;
case unsave of begin
[bottomlevel] begin error("Too many }'s"); go to bigswitch end;
[simpleblock] go to bigswitch;
[trueend] begin do getnctok until curcmd≠spacer;
if curcmd≠elsecode then backerror("Missing \else inserted");
passblock # bypass the else clause and an optional space that follows it;
go to bigswitch end;
[falseend] begin getnctok; if curcmd=spacer then getnctok;
go to reswitch end;
[mathcode][mathleft] go to extrarb;
[aligncode] begin if alignrecord<0 then go to extrarb;
curtok←rbrace lsh cmdd; backerror("Missing \cr inserted");
curlev←curlev+level1;
saveptr←saveptr+1; curcmd←carret; aligndelim; go to bigswitch end;
[outputend] go to endoutput;
[noalignend] go to aligntest;
[topinsend][botinsend][topsepend][botsepend] go to topbotinsend;
[justend] begin saveptr←saveptr-3; go to justbox end;
[mathblock] begin curbox←finishmlist(0); go to makemathbox end;
[endscanmath] begin curitem←finishmlist(0); saveptr←saveptr-1;
go to scanmathend end;
[endvcenter] begin saveptr←saveptr-1; curnoad←getnode(noadsize);
mem[curnoad]←(boxnoad lsh typed)+(savestack[saveptr]lsh valued)
# special box noad;
operand(curnoad)←vpackage(head,0,false,1) # box the current vlist;
popnest; go to addtomlist end;
else confusion
end; end;
[vmode+mathbr][vmode+letter][vmode+otherchar][vmode+noindent][vmode+accent]
[vmode+nonmathletter][vmode+caseshift][vmode+exspace] begin integer q;
checkpriv # beginning of a paragraph, must be in +vmode;
q←eqlink(parskip);store((gluenode lsh typed)+(q lsh valued));
mem[q]←mem[q]+refct1;
pushnest; mode←hmode; spacefactor←1.0;
if curcmd=noindent then go to bigswitch;
q←getnode(boxnodesize); mem[curnode]←q; curnode←q;
mem[q]←hlistnode lsh typed;
width(q)←pagemem[parindentmem] # We needn't bother to make glueset(q)≠0,
even though this empty box has nonstandard dimensions,
since it won't appear in a formula;
go to reswitch end;
[hmode+mathbr] begin if mathfonttable(0)<0 or mathfonttable(1)<0
or mathfonttable(2)<0 or mathfonttable(3)<0 then go to missingfont;
mathfonttable(7)←mathfonttable(11)←mathfonttable(3) # fill in redundancies;
getnctok;
if mode<0 and curcmd=mathbr then go to fallthru # $$ in restricted horizontal mode;
newsavelevel(mathcode) # guard against extra }'s between the $'s;
if curcmd≠mathbr then
begin comment single $ sensed (beginning of formula in text);
pushnest; mode←-mmode; incompleatnoad←0;
go to reswitch;
end;
comment $$ sensed (beginning of displayed formula);
if mem[head]=0 then
begin comment display at beginning of nonindented paragraph,
or (more likely) following another display;
abovedisplaywidth←-1000000.0 # force use of dispaskip glue;
popnest # forget the null paragraph and return to vmode of page builder;
end
else begin comment Output the paragraph so far;
finishparagraph(false);
abovedisplaywidth←lastwidth+2.0*mathpar(quad,textsize) # save the
length of final line plus two quads;
hangbegin←hangbegin-lines # maintain count for hanging indent;
store((penaltynode lsh typed)+(disppen lsh valued)) # penalty for break;
end;
pushnest; mode←mmode; incompleatnoad←0; eqnobox←0; dpenalty←0; go to addtopage end;
[mmode+eqno] begin checkpriv; pushnest; mode←-mmode; incompleatnoad←0;
newsavelevel(mathcode); leqno←curchar; go to bigswitch end;
[mmode+mathbr] begin integer p,m; m←mode;
if unsave≠mathcode then go to missingbrace;
p←finishmlist(0) land ((1 lsh links)-1);
comment Now p is 0 or points to the completed noad list for the formula.
The nest has been popped to its previous level;
if m>0 then
begin comment end of displayed math, we're now in vmode of the page builder;
getnctok; if curcmd≠mathbr then
backerror("Display math should end with $$");
p←compactlist(evalmlist(p,dispstyle,false));
finishdisplay(p) # append displayed equation to page;
getnctok; if curcmd≠spacer then backinput # ignore space after closing $$;
pushnest; mode←hmode; spacefactor←1.0 # prepare to resume paragraph;
go to addtopage;
end;
p←compactlist(evalmlist(p,textstyle,true));
if mode=mmode then
begin comment p points to the hlist for an equation number;
eqnobox←hpack(p,0,1);
go to reswitch # the $ after an equation number does double duty;
end;
comment Now p points to the hlist for a math formula in text. We will surround it
with hyphenation control nodes and append it to the current hlist;
if pagemem[mathsurrmem] then
begin integer q; q←getnode(kernnodesize); width(q)←pagemem[mathsurrmem];
mem[curnode]←mem[curnode]+q; mem[q]←kernnode lsh typed; curnode←q;
end;
store((hyphnode lsh typed)+p);
while (p←link(curnode))≠0 do curnode←p;
if pagemem[mathsurrmem] then
begin integer q; q←getnode(kernnodesize); width(q)←pagemem[mathsurrmem];
store((hyphnode lsh typed)+(1 lsh valued)+q);
mem[q]←(kernnode lsh typed); curnode←q;
end
else store((hyphnode lsh typed)+(1 lsh valued));
spacefactor←1.0; go to bigswitch; end;
[vmode+tabmrk][vmode+carret][hmode+tabmrk][hmode+carret][mmode+tabmrk][mmode+carret]
begin error("There's no \halign or \valign going on"); go to bigswitch end;
[mmode+supmrk][mmode+submrk] begin integer prevsetting; prevsetting←0;
if curnode=head or type(curnode)≥abovenoad
or (prevsetting←mem[curnode+curcmd-supdelta])≠0 then
begin comment insert dummy noad to be sub/superscripted;
integer p; p←getnode(noadsize);
mem[curnode]←mem[curnode]+p;
if prevsetting then error("Double "&
(if curcmd=supmrk then "super" else "sub")&"script");
curnode←p;
end;
savestack[saveptr]←curnode+curcmd-supdelta # location of supscr or subscr field;
go to scanmath; end;
[vmode+spacer][vmode+parend][mmode+spacer] go to bigswitch;
[hmode+spacer][hmode+exspace] begin integer p,curfont; p←eqlink(spaceskip);
if p=zeroglue or (gluespace(p)=0 and gluestretch(p)=0 and glueshrink(p)=0) then
begin curfont←eqlink(font);
if curfont≥nfonts then go to missingfont;
p←fontglue+curfont*gluespecsize # this glue has infinite reference count;
end;
if spacefactor ≠ 1.0 and curcmd≠exspace then
begin integer q;
q←getnode(gluespecsize);
gluespace(q)←gluespace(p);
gluestretch(q)←gluestretch(p)*spacefactor;
glueshrink(q)←glueshrink(p)/spacefactor;
if spacefactor > 2.0 then
begin p←eqlink(xspaceskip);
if p=zeroglue or (gluespace(p)=0 and gluestretch(p)=0
and glueshrink(p)=0) then
begin curfont←eqlink(font);
if curfont≥nfonts then go to missingfont;
gluespace(q)←gluespace(q)+fontpar(curfont,extraspace);
p←q;
end
else mem[p]←mem[p]+refct1;
end
else p←q;
end
else mem[p]←mem[p]+refct1;
store((p lsh valued)+(gluenode lsh typed));
go to bigswitch end;
[hmode+mathstyle] case curchar of begin
[negthinspace] begin comment This is the routine for \!;
getnctok; if curcmd≠spacer then go to reswitch else go to bigswitch end;
[quadspace] begin comment \quad in horizontal mode;
integer q,curfont; curfont←eqlink(font);
if curfont≥nfonts then go to missingfont;
q←getnode(gluespecsize);
gluespace(q)←fontpar(curfont,quad);
store((q lsh valued)+(gluenode lsh typed)); go to bigswitch end;
else go to fallthru
end;
[mmode+exspace][mmode+mathstyle] begin store((stylenoad lsh typed)+
(curchar lsh valued)); go to bigswitch; end;
[mmode+letter][mmode+otherchar] begin curchar←mmodecode(curchar) land '7777;
go to mathchar end;
[mmode+mathonly] go to mathchar;
[mmode+ascii] begin curchar←scannumber land '777; go to mathchar end;
[hmode+letter][hmode+otherchar][hmode+nonmathletter] begin integer t,x; label pchar;
integer lchar # character most recently gobbled up;
integer curfont # current font number;
define utglig = taglig lsh tgd # to avoid shift in the inner loop;
curfont←eqlink(font); if curfont≥nfonts then go to missingfont;
lchar←curchar;
pchar: if sftable[curchar] and
(field(type,t←mem[curnode])≠charnode or (t←(t lsh -valued) land '177)<"A" or t>"Z")
then spacefactor←sftable[curchar] # No spacefactor correction is made after
upper case letters (consider, e.g., "D. E. Knuth");
t←(curfont lsh 7)+curchar;
x←fontinfo[t];
getnext;
if ufield(tg,x)=utglig then
begin integer j,ligkernstep;
j←field(rm,x)+lgbase[curfont];
loop begin ligkernstep←fmem[j];
if(curchar xor nextchar(ligkernstep))land '177 = 0 and
(curcmd=letter or curcmd=otherchar)
then begin comment second letter of ligature pair found;
integer p, llchar;
llchar←lchar; lchar←curchar;
curchar←remainder(ligkernstep);
if tagbit(ligkernstep)=ligstep then go to pchar;
comment It's a kern specification, not a ligature;
store(t lsh valued) # store a charnode;
if llchar land '177 = "-" then store(discnode lsh typed);
p←getnode(kernnodesize);
mem[curnode]←mem[curnode]+p;
mem[p]←kernnode lsh typed;
gluespace(p)←fmemreal(curchar+krbase[curfont]);
curnode←p; curchar←lchar; go to reswitch;
end;
if ligkernstep<0 then done;
j←j+1;
end;
end;
store(t lsh valued);
if lchar land '177 = "-" then store(discnode lsh typed) # break without
penalty is allowed after explicit hyphens;
go to reswitch end;
[hmode+parend] begin if mode<0 then go to bigswitch;
if mem[head] then finishparagraph(true) else popnest;
hangbegin←1000000; hangfirst←false # reset hanging indent;
go to addtopage end;
[mmode+parend][mmode+endv] begin curtok←curcmd lsh cmdd;
backerror("Missing $ inserted"); curcmd←mathbr; go to reswitch end;
[vmode+endv][hmode+endv] begin if unsave≠aligncode then go to missingbrace;
finishunsetnode;
newsavelevel(aligncode);
if alignrecord<0 then
begin finishalignbox; go to aligntest;
end;
alignrecord←mem[alignrecord]; startunsetnode; go to bigswitch end;
[vmode+kall][hmode+kall][mmode+kall] begin macrocall; go to bigswitch end;
[vmode+xt][hmode+xt][mmode+xt] begin extop; go to bigswitch end;
[vmode+assignreal][hmode+assignreal][mmode+assignreal] begin
pagemem[curchar]←scanlength; go to bigswitch end;
[vmode+assignglue][hmode+assignglue][mmode+assignglue] begin integer p,h;
comment This is for things like \lineskip, \parskip, etc.;
h←curchar; if h=specskiploc then h←(specskiploc-"0")+scandigit;
p←scanglue; eqdefine(h,glueref,p); go to bigswitch end;
[vmode+font][hmode+font] begin eqdefine(fontloc,font,scanfont(true));
go to bigswitch end;
[vmode+def][hmode+def][mmode+def] begin macrodef(curchar); go to bigswitch end;
[vmode+output][hmode+output][mmode+output] begin
if outputroutine then delrclink(outputroutine);
outputroutine←scantoks; go to bigswitch end;
[vmode+innput] begin inputfile; lvl←curlev; go to bigswitch end;
[vmode+stop] begin checkpriv;
if pagehead=pagetail then
begin if deadcycles=0 or deadcycles>25 then
begin if curlev≠level1 then print(nextline,
"(\end occurred on level ",(curlev-level1)lsh-idlevd,")");
JSTAT if xpar2 then jstatout;
return;
end;
pagetail←getnode(boxnodesize); mem[pagetail]←hlistnode lsh typed;
height(pagetail)←pagemem[vsizemem]; width(pagetail)←pagemem[hsizemem];
mem[pagehead]←pagetail # append empty box (dummy page);
end;
comment That was the normal way to terminate TEX. The condition pagehead=pagetail
implies that waitinghead=waitingtail and contrib=0. But if pagehead≠pagetail,
we need to flush out everything that is still waiting to be output;
finaleject←true;
curtok←hashentry; backinput; curcmd←eject; curchar←1; go to reswitch end;
[vmode+ddt][hmode+ddt][mmode+ddt] begin if tracing land 4 then dumpactivities;
MSTAT print(nextline,"<Memory usage: max ",maxvarused,",",maxdynused,
MSTAT '73&" current ",varused, ",", dynused,">");
if tracing land '40 then error("OK");
go to bigswitch end;
[vmode+ascii][hmode+ascii] begin curchar←scannumber land '177;
curcmd←otherchar; go to reswitch; end;
[vmode+chcode][hmode+chcode][mmode+chcode] begin integer j,v; j←curchar;
j←scannumber+j # j now identifies the parameter or character code location;
getnctok # this token is ignored, it might be space or = or ←, etc.;
if curcmd=endv then backerror("Missing } inserted");
v←scannumber; if nbrsign="-" then v←-v;
chcodedef(j,v); go to bigswitch end;
[vmode+fntfam][hmode+fntfam] begin integer c; c←curchar;
chcodedef(256+c,scanfont(true));
if c≠3 then
begin chcodedef(256+c+scrsize,scanfont(true));
chcodedef(256+c+scrscrsize,scanfont(true));
end;
go to bigswitch end;
[vmode+setcount][hmode+setcount][mmode+setcount] begin integer d; d←scandigit;
kount[d]←scannumber;
if nbrsign="-" then kount[d]←-kount[d];
go to bigswitch end;
[vmode+advcount][hmode+advcount][mmode+advcount] begin integer d,n; d←scandigit;
if scanstring("by") then n←scannumber
else begin n←1; if kount[d]<0 then nbrsign←"-" else nbrsign←0;
end;
if nbrsign≠"-" then kount[d]←kount[d]+n else kount[d]←kount[d]-n;
go to bigswitch end;
[vmode+count][hmode+count][mmode+count] begin integer d; d←scandigit;
insnum(kount[d]); go to bigswitch end;
[vmode+ifeven][hmode+ifeven][mmode+ifeven] begin integer c,d; c←curchar;
d←scandigit;
if c then scancond(kount[d]>0) else scancond((kount[d]+1)land 1);
go to bigswitch end;
[vmode+ifmode][hmode+ifmode][mmode+ifmode] begin scancond(abs(mode)=curchar);
go to bigswitch end;
[vmode+ifT][hmode+ifT][mmode+ifT] begin integer c; getnctok; if curcmd≥charcodes
then begin backerror("Incomplete \if"); go to bigswitch end else c←curchar;
getnctok; if curcmd≥charcodes then begin backerror("Incomplete \if");
go to bigswitch end else scancond(curchar=c);
comment Although an endv code is unlikely here, it is best to make sure that
endv can't be gobbled up under any circumstances, hence "backerror" not "error";
go to bigswitch end;
[vmode+ifx][hmode+ifx][mmode+ifx] begin integer p1,p2;
gettok; while hashentry<0 do
begin backerror("Two control sequences must follow \ifx"); gettok;
end;
if curcmd=kall then p1←link(link(curchar)) else if curcmd=0 then p1←-1
else p1←-((curcmd lsh valued)+curchar);
gettok; while hashentry<0 do
begin backerror("Two control sequences must follow \ifx"); gettok;
end;
if curcmd=kall then p2←link(link(curchar)) else if curcmd=0 then p2←-1
else p2←-((curcmd lsh valued)+curchar);
while p1>0 and p2>0 do
begin if info(p1)≠info(p2) then done; p1←link(p1); p2←link(p2);
end;
scancond(p1=p2); go to bigswitch end;
[vmode+box][hmode+box][mmode+box] begin savestack[saveptr]←0; go to beginbox end;
[vmode+unbox][hmode+unbox] begin integer d,p; d←scandigit; p←savedbox[d];
if p then
begin integer t; t←case type(p)-hlistnode of (hmode,vmode);
if abs(mode)≠t then
begin error("You can't switch horizontal and vertical lists");
go to bigswitch;
end;
p←value(p); freenode(savedbox[d],boxnodesize);
end;
savedbox[d]←0; mem[curnode]←mem[curnode]+p;
while p do
begin curnode←p; p←link(p);
end;
if abs(mode)=vmode then prevdepth←pflag else spacefactor←1.0;
if mode=vmode then go to addtopage else go to bigswitch end;
[vmode+hmove][hmode+vmove][mmode+vmove] begin integer c; real shft;
c←curchar; shft←scanlength; if nbrsign="-" then shft←-shft;
if c then shft←-shft # moveleft or raise negates the amount of shift;
savestack[saveptr]←memory[location(shft),integer]; go to scanbox end;
[vmode+save][hmode+save][mmode+save] begin savestack[saveptr]←scandigit;
go to scanbox end;
[vmode+leaders][hmode+leaders] begin savestack[saveptr]←curchar; go to scanbox end;
[vmode+halign][hmode+valign][mmode+halign] begin if mode=-mmode then go to fallthru;
initalign; go to aligntest end;
[vmode+vskip][hmode+hskip][mmode+hskip] begin integer p;
if curchar=100 then
begin comment \mskip; if abs(mode)≠mmode then go to fallthru;
dimmode←1; curchar←0;
store((stylenoad lsh typed)+(mspace lsh valued));
end;
p←case curchar of (scanglue,fillglue,filglue,filglueneg,lowerfillglue);
dimmode←0; curitem←(p lsh valued)+(gluenode lsh typed); go to simpleappend end;
[vmode+skp][hmode+skp][mmode+skp] begin integer p;
p←field(link,eqtb[(specskiploc-"0")+scandigit]) # stored link field for specskip;
mem[p]←mem[p]+refct1;
curitem←(p lsh valued)+(gluenode lsh typed); go to simpleappend end;
[vmode+hrule][hmode+vrule] begin integer p; p←scanrulespec;
mem[curnode]←mem[curnode]+p; curnode←p;
if abs(mode)=vmode then
begin prevdepth←pflag;
if mode>0 then go to addtopage else go to bigswitch;
end;
spacefactor←1.0; go to bigswitch end;
[vmode+topbotins][hmode+topbotins] begin integer j; checkpriv;
if curchar>1 and mode≠vmode then go to fallthru;
j←curchar; pushnest; mode←-vmode; prevdepth←pflag;
scanlb; newsavelevel(botinsend+j); go to bigswitch end;
[vmode+topbotmark][hmode+topbotmark][mmode+topbotmark] begin integer p;
if outputdormant then go to outputonly;
p←case curchar of (botmark,topmark,firstmark);
if p then insrclist(p);
go to bigswitch end;
[vmode+mark][hmode+mark] begin integer p; checkpriv;
p←scantoks;
store((p lsh valued)+(marknode lsh typed));
if mode=vmode then go to addtopage;
getnctok; if curcmd≠spacer then backinput # optional space after the mark;
go to bigswitch end;
[vmode+penlty][hmode+penlty][mmode+penlty] begin integer n,p; p←curchar;
if p and (mode≠mmode) then go to fallthru;
n←scannumber;if nbrsign="-" then n←(-(n min(1 lsh(values-1))))land((1 lsh values)-1)
else if n>infpen then n←infpen;
comment In other words, any penalty less than the minimum we can store is stored as
the minimum, and any penalty greater than the maximum is stored as the max;
if p then begin dpenalty←n; go to bigswitch end;
curitem←(penaltynode lsh typed)+(n lsh valued);
go to simpleappend end;
[vmode+eject][hmode+eject][mmode+eject] begin if mode=+mmode or
(curchar=0 and abs(mode)=vmode) then go to fallthru;
curitem←(ejectnode lsh typed)+(curchar lsh valued); go to simpleappend end;
[hmode+discr] begin integer curfont; curfont←eqlink(font);
if curfont≥nfonts then go to missingfont;
store((((curfont lsh 7)+(curchar land '177))lsh valued)
+(discnode lsh typed)); go to bigswitch end;
[mmode+discr] begin curitem←(curchar lsh valued)+(discnode lsh typed);
go to simpleappend end;
[vmode+newaccent][hmode+newaccent][mmode+newaccent] begin curchar←scannumber;
if abs(mode)≠mmode then curchar←curchar land '177 else curchar←curchar land '777;
curcmd←accent; go to reswitch end;
[hmode+accent] begin integer a,b,c,f,p,q,r,x,curfont; real s,t,w,h;
curfont←f←eqlink(font); if f≥nfonts then go to missingfont;
a←curchar+(f lsh 7); s←fontpar(f,slant); t←fontpar(f,xheight);
comment a is the accent, it has slant s and is designed for characters of height t;
loop begin getnctok;
if curcmd≠font then done;
eqdefine(fontloc,font,curfont←scanfont(true));
end;
if curcmd=ascii then curchar←scannumber land '177
else if curcmd≠letter and curcmd≠otherchar and curcmd≠nonmathletter then
begin error("Only single characters can be accented in horizontal mode");
go to reswitch;
end;
q←getnode(boxnodesize);
getavail(p); mem[p]←(c←curchar+(curfont lsh 7)) lsh valued # charnode for accentee;
getavail(r); mem[r]←lowerfillgluespec+p;
comment lowerfillglue is used here since it will have to shrink;
getavail(p); mem[p]←(a lsh valued) # charnode for the accenter;
mem[q]←(hlistnode lsh typed)+(p lsh valued)+r;
height(q)←charht(f,x←fontinfo[a]);
width(q)←charwd(f,x); depth(q)←chardp(f,x);
h←charht(curfont,x←fontinfo[c]); w←charwd(curfont,x);
shiftamt(q)←(w-width(q))/2+fontpar(curfont,slant)*h-s*t;
b←vpack(q,height(q)+h-t,0); width(b)←w;
mem[curnode]←mem[curnode]+b; curnode←b; go to bigswitch end;
[mmode+accent][mmode+mathinput] begin curnoad←getnode(noadsize);
if curcmd=accent then mem[curnoad]←(accentnoad lsh typed)+(curchar lsh valued)
else mem[curnoad]←curchar lsh typed # curchar is the type of noad;
mem[curnode]←mem[curnode]+curnoad; curnode←curnoad;
savestack[saveptr]←curnoad+1 # put location of operand field onto savestack;
go to scanmath end;
[mmode+leftright] begin integer p; p←curchar # leftnoad or rightnoad;
if p=rightnoad and unsave≠mathleft then
begin integer garbage;
if savestack[saveptr]≠-mathcode then go to missingbrace;
garbage←scandelim; error("Extra \right");
saveptr←saveptr+1; curlev←curlev+level1 # restore mathcode on savestack;
go to bigswitch;
end;
curnoad←getnode(noadsize); mem[curnoad]←p lsh typed;
operand(curnoad)←scandelim;
if p=leftnoad then
begin comment enter a new level of braces (\left is like {\left);
newsavelevel(mathleft);
pushnest; incompleatnoad←0;
mem[head]←curnode←curnoad;
go to bigswitch;
end;
comment p=rightnoad, conclude the old level of braces (\right is like \right});
curbox←finishmlist(curnoad); go to makemathbox end;
[mmode+above] begin if incompleatnoad≠0 then
begin comment two \above's in same mlist;
real garbage;
case curchar of begin
[0] garbage←scanlength;
[1][2] ;
[3] begin garbage←scandelim;garbage←scandelim; end;
else confusion end;
error("Ambiguous; you need another { and }"); go to bigswitch;
end;
incompleatnoad←getnode(noadsize+2); mem[incompleatnoad]←abovenoad lsh typed;
if mem[head] then supscr(incompleatnoad)←mem[head] lor fflag # the numerator mlist;
case curchar of begin
[0] aboverule(incompleatnoad)←scanlength # \above <length>;
[1] # \atop;
[2] aboverule(incompleatnoad)←defaultrulethickness # \over;
[3] begin ldelim(incompleatnoad)←scandelim;
rdelim(incompleatnoad)←scandelim; end # \comb;
else confusion end;
mem[head]←0; curnode←head; go to bigswitch end;
[mmode+limsw] begin if type(curnode)≠opnoad then
error("Limit switch must follow math operator")
else mem[curnode]←mem[curnode] xor (1 lsh valued); go to bigswitch end;
[hmode+caseshift] begin integer p,q,c; c←curchar; p←scantoks;
q←p; while q←link(q) do if mem[q] lsh(-infod-cmdd) = letter then
begin if c then mem[q]←mem[q] land (lnot('40 lsh infod))
else mem[q]←mem[q] lor ('40 lsh infod);
end;
pushinput; state←tokenlist; recovery←p; loc←link(p); go to bigswitch end;
[hmode+italcorr] begin if curnode=head or type(curnode)≠charnode then
error("Italic correction must follow an explicit character")
else begin comment compute italic correction; integer c,f,b,j;
c←info(curnode); f←c lsh -7; j←field(ic,fontinfo[c]);
if j then
begin b←getnode(boxnodesize);
width(b)←fmemreal(icbase[f]+j);
glueset(b)←epsilon; mem[b]←(hlistnode lsh typed);
mem[curnode]←mem[curnode]+b; curnode←b;
end;
end;
spacefactor←1.0; go to bigswitch end;
[mmode+vcenter] begin savestack[saveptr]←curchar; saveptr←saveptr+1;
newsavelevel(endvcenter);
pushnest; mode←-vmode; prevdepth←pflag; scanlb; go to bigswitch end;
[vmode+hangindent][hmode+hangindent] begin real hw; integer hb; boolean hf;
hw←scanlength;
if scanstring("for") then begin hb←scannumber; hf←true end
else if scanstring("after") then begin hb←scannumber; hf←false end
else begin hb←1; hf←false end;
if mode=-hmode then
begin chcodedef(268,hb) # set innerhangbegin;
chcodedef(269,hf) # set innerhangfirst;
chcodedef(270,0 lor hw) # set innerhangwidth;
end
else begin hangbegin←hb; hangfirst←hf; hangwidth←hw;
end;
go to bigswitch end;
[vmode+unskip][hmode+unskip] begin if mode=vmode then go to fallthru;
if type(curnode)=gluenode then
begin integer p,q; p←head; while (q←link(p))≠curnode do p←q;
delgluelink(value(curnode));
freeavail(curnode); setlink(p,0); curnode←p;
end;
go to bigswitch end;
[vmode+send][hmode+send][mmode+send] begin integer c,d; c←curchar; d←scandigit;
if c then
begin comment This is the code for \open d;
getnctok # this token is ignored, it might be = or ←, etc.;
if curcmd=endv then backerror("Missing } inserted");
if sendout[d]≥0 then release(sendout[d]);
sendout[d]←opendigit(d); go to bigswitch;
end
else begin comment This is the code for \send d;
integer p,q; p←getnode(sendnodesize); mem[p]←whatsitnode lsh typed;
curcmd←mark; hashentry←hashsend; q←scantoks # scan the mark text;
mem[p+1]←(d lsh valued)+q # set up sendstream(p), sendtoks(p);
gettok; if curcmd neq spacer then backinput;
whatsitappend(p);
end;
go to addtopage end;
[vmode+ifdimen][hmode+ifdimen][mmode+ifdimen] begin real x,y; integer c;
x←scanlength;
loop begin getnctok; c←curchar;
case c of begin
["<"] begin c←0; done end;
["="] begin c←1; done end;
[">"] begin c←2; done end;
["≥"] begin c←3; done end;
["≠"] begin c←4; done end;
["≤"] begin c←5; done end;
else backerror("Illegal relation symbol")
end
end;
y←scanlength; scancond(case c of (x<y,x=y,x>y,x≥y,x≠y,x≤y)); go to bigswitch end;
[vmode+deffont][hmode+deffont][mmode+deffont] begin scanfont(false);
go to bigswitch end;
[vmode+altname][hmode+altname][mmode+altname] begin integer lhsplace,rhsplace,c,p;
label alterror;
gettok; if (lhsplace←hashentry)<0 then go to alterror;
getnctok # ignore the next token (= or ←, etc.);
gettok; if (rhsplace←hashentry)<0 then go to alterror;
c←field(idcmd,eqtb[rhsplace]); p←field(link,eqtb[rhsplace]);
if c=kall then mem[p]←mem[p]+refct1 # increase reference count if necessary;
eqdefine(lhsplace,c,p); go to bigswitch;
alterror: backerror("You can only use \let with control sequences");
go to bigswitch end;
[vmode+shape][hmode+shape][mmode+shape] begin integer n,i;
if parshape then freenode(parshape,2*mem[parshape]+1);
n←scannumber;
if n then
begin parshape←getnode(2*n+1); mem[parshape]←n;
for i←1 thru n do
begin memreal(parshape+2*i-1)←scanlength;
memreal(parshape+2*i)←scanlength;
end;
end
else parshape←0; go to bigswitch end;
[hmode+spcfctr] begin spacefactor←scannumber; getnctok;
if curtok=(otherchar lsh cmdd)+"." then
begin integer n; n←scannumber;
spacefactor←spacefactor+n/10.0↑nbrlength;
end
else backinput;
if spacefactor<1.0 then spacefactor←1.0;
go to bigswitch end;
else go to fallthru
end;
comment Ending of the main procedure;
fallthru:error("You can't do that in "&decodemode(mode)&" mode"); go to bigswitch;
outputonly: error("This is allowed only in output routines"); go to bigswitch;
missingfont: pausing_on_errors←false # we're about to quit;
error("Whoa---you have to define a font first"); quit;
extrarb: alignstate←alignstate+1; error("Extra }");
saveptr←saveptr+1; curlev←curlev+level1; go to bigswitch;
missingbrace: if curcmd>15 then curtok←hashentry
else curtok←(curcmd lsh cmdd)+curchar # prepare to back up input;
if savestack[saveptr]=-mathcode then
begin backerror("Missing $ inserted"); curcmd←mathbr;
end
else if savestack[saveptr]=-mathleft then
begin integer q; backerror("Missing \right. inserted");
curcmd←leftright; curchar←rightnoad;
getavail(q); mem[q]←((otherchar lsh cmdd)+".") lsh infod; inslist(q);
end
else begin backerror("Missing } inserted"); curcmd←rbrace;
end;
saveptr←saveptr+1; curlev←curlev+level1 # undo damage of incorrect unsave;
go to reswitch # try again with the missing character(s) supplied;
scanbox: getncnext;
if curcmd≠box then
begin if savestack[saveptr]≥":" and savestack[saveptr]≤"<" and
(curcmd=hrule or curcmd=vrule) then
begin comment \leaders\hrule or \leaders\vrule;
curbox←scanrulespec; go to boxend;
end;
error("A box specification was supposed to be here");
go to reswitch;
end;
beginbox: comment At this point curcmd=box, curchar=0, 1, 2, 3, 3+vmode, or 3+hmode,
according as the first token of the box specification is \page, \box, \copy, \thebox,
\vbox, or \hbox, respectively. Also savestack[saveptr] contains either a shift amount
(a signed real value) or one of the small integers "0" thru "9" (denoting \save)
or ":" thru "<" (denoting \cleaders, \leaders, \xleaders);
if curchar>3 then
begin pushnest # prepare for hbox or vbox;
if curchar=3+vmode then prevdepth←pflag else spacefactor←1.0;
mode←3-curchar # -vmode or -hmode;
saveptr←saveptr+1 # not necessary to test saveptr<savesize here;
scanspec # scan remainder of specification, put size parameter and
justification code on savestack;
newsavelevel(justend) # this will send control to justbox when the } occurs;
if savestack[saveptr-2]=2 then
begin comment The beginning of \hbox par ..., reset hanging indent;
chcodedef(268,1000000) # innerhangbegin←1000000;
chcodedef(269,0) # innerhangfirst←false;
comment There's no need to initialize innerhangwidth;
end;
go to bigswitch;
end;
case curchar of begin
[0] begin if outputdormant then go to outputonly # \page;
curbox←savedpage; savedpage←0 end;
[1][2] begin integer c,d; c←curchar; d←scandigit # \box d or \copy d;
curbox←savedbox[d];
if c=1 then savedbox[d]←0 else savedbox[d]←boxcopy(curbox) end;
[3] begin if abs(mode)≠mmode and (type(curnode)=hlistnode or
type(curnode)=vlistnode) then
begin integer p,q # remove the box at the end of the current list;
p←head; while (q←link(p))≠curnode do p←q;
setlink(p,0); curbox←curnode; curnode←p;
end
else curbox←0 end;
else confusion
end;
go to boxend;
justbox: begin comment At this point "head" points to the head of a list to
be justified, savestack[saveptr+1] contains the associated length specification,
and savestack[saveptr+2] is 0, 1, or 2 according as the justification was called by
"to", "expand", or "par";
real len; integer c;
len←memory[location(savestack[saveptr+1]),real]; c←savestack[saveptr+2];
if mode = -vmode then curbox←vpackage(head,len,false,c) comment finish vbox;
else if c≠2 then
begin curbox←hpackage(head,len,c) # finish \hbox to...{ or \hbox expand...{;
dsnodelist(mem[inserts]);
end
else begin comment finish \hbox par ...{;
store(infpenspec); storepargluespec # append fill glue to paragraph end;
mem[temphead]←mem[head]; mem[head]←0; curnode←head;
mode←-vmode; prevdepth←pflag # prepare for inter-line spacing;
justification(len,inhangbegin,inhangfirst,inhangwidth,false);
curbox←vpackage(head,0,false,1);
end;
popnest; end # Now the program continues at boxend;
boxend: comment At this point curbox points to a newly built box, possibly null, and
savestack[saveptr] contains either a shift amount (a signed real value) or one
of the small integers "0" thru "9" (denoting \save) or ":" thru "<"
(denoting \cleaders, \leaders, \xleaders);
begin integer t; t←savestack[saveptr];
if t≥"0" and t≤"9" then
begin if savedbox[t] then dsnodelist(savedbox[t]);
savedbox[t] ← curbox;
go to bigswitch;
end;
if curbox then
begin if t≥":" and t≤"<" then
begin if type(curbox)≠rulenode then shiftamt(curbox)←t-";";
store((leadernode lsh typed)+(curbox lsh valued));
end
else begin shiftamt(curbox)←memory[location(t),real];
if abs(mode)=mmode then go to makemathbox;
append(curbox);
end;
if mode=vmode then go to addtopage else go to bigswitch;
end;
go to bigswitch end;
simpleappend: comment At this point, curitem is a one-word item to be appended
to the current list;
if abs(mode)=mmode then
begin comment In math mode, append a "nodenoad";
integer p; getavail(p); mem[p]←curitem # deposit item into separate node;
store((p lsh valued)+(nodenoad lsh typed)); go to bigswitch;
end;
store(curitem);
if mode=vmode then go to addtopage else go to bigswitch;
aligntest: comment We get here after the \cr of an alignment, or after \noalign{...};
do getnctok until curcmd≠spacer;
if curcmd=noalign then
begin comment insertion into the alignment;
scanlb;newsavelevel(noalignend) # the right brace will bring us back here;
go to bigswitch;
end;
if curcmd=rbrace then
begin comment end of the alignment;
endalign;
if mode=vmode then go to addtopage;
if mode=mmode then
begin do getnctok until curcmd≠spacer;
if curcmd≠mathbr or mem[head] then
error("\halign in math mode must be preceded and followed by $$");
go to reswitch;
end;
go to bigswitch;
end;
backinput # the token will reappear after the u1 tokenlist;
startalignbox;
startunsetnode;
go to bigswitch;
makemathbox: comment At this point curbox points to a sub-mlist that is to
be made the operand of a new boxnoad and appended to the current mlist;
curnoad←getnode(noadsize) # mem[curnoad] = boxnoad lsh typed, since boxnoad=0;
operand(curnoad)←curbox;
go to addtomlist;
mathchar: comment At this point curchar consists of a 4-bit noad type
followed by a 9-bit math character code, and we want to make it the
operand of a new noad and append this to the current mlist;
curnoad←getnode(noadsize);
mem[curnoad]←(curchar land '17000) lsh (typed-9);
operand(curnoad) ← (curchar land '777) lor flag;
addtomlist: comment Now curnoad points to a noad that should be appended to
the current mlist;
mem[curnode]←mem[curnode]+curnoad; curnode←curnoad; go to bigswitch;
scanmath: comment At this point the next portion of the input should be either
a single character or "{<mlist>}", and we want to put the corresponding
operand code into the noad field whose address is in savestack[saveptr];
do getnctok until curcmd≠spacer;
if curcmd=letter or curcmd=otherchar then
begin curitem←flag+(mmodecode(curchar) land '777); go to scanmathend;
end;
if curcmd=mathonly then
begin curitem←flag+(curchar land '777); go to scanmathend;
end;
if curcmd=ascii then
begin curitem←flag+scannumber; go to scanmathend;
end;
comment it wasn't a single character;
if curcmd≠lbrace then
begin alignstate←alignstate+1; backerror("Missing { inserted");
end;
saveptr←saveptr+1; newsavelevel(endscanmath); pushnest; incompleatnoad←0;
go to bigswitch;
scanmathend: mem[savestack[saveptr]]←curitem; go to bigswitch;
topbotinsend: comment At this point the current vlist is to be converted into
a top/botinsert or top/botsep, according to whether -savestack[saveptr]-botinsend
is 0,1,2,or 3;
begin integer p,q,t;
t←(-savestack[saveptr])-botinsend;
if t≤1 then
begin getavail(p);
if t then
begin comment append topskip glue at end of vlist;
q←eqlink(topskip);
mem[p]←(q lsh valued)+(gluenode lsh typed);
mem[curnode]←mem[curnode]+p;
end
else begin comment insert botskip glue at beginning of vlist;
q←eqlink(botskip);
mem[p]←(q lsh valued)+(gluenode lsh typed)+mem[head];
mem[head]←p;
end;
mem[q]←mem[q]+refct1;
q←getnode(insspecsize);
end
else begin q←separatorspec+insspecsize*(t-2);
if mem[q] then dsnodelist(value(q));
end;
p←vpackage(head,0,false,1);
mem[q]←(t lsh typed)+ufield(value,mem[p]);
gluespace(q)←height(p);
gluestretch(q)←str;
glueshrink(q)←shr;
insdepth(q)←depth(p);
freenode(p,boxnodesize);
popnest;
if t>1 then go to bigswitch;
getavail(p); mem[p]←(insnode lsh typed)+(q lsh valued);
if mode=vmode then
begin contrib←p; mem[q]←mem[q]+(2 lsh typed); go to addtopage;
end;
mem[curnode]←mem[curnode]+p; curnode←p; go to bigswitch;
end;
addtopage: comment Now the page builder is in operation, it continues to
work until contrib=0, then control will go back to bigswitch. The current
semantic mode need not be vmode, it reflects the mode we should be in when
bigswitch eventually takes over;
if contrib=0 then
begin if nestptr=0 then curnode←contribhead
else curndstack[0]←contribhead # reset contribution list;
go to bigswitch;
end;
if pagetail=pagehead then
begin comment Initialization of page building;
curbreak←0; curbadness←10.0↑30;
pagesize←pagemem[vsizemem];
pagedepthmax←pagemem[maxdepthmem];
pagetopbl←pagemem[topbaselinemem];
pageheight←pagestretch←pageshrink←pagedepth←
pageinsdepth[0]←pageinsdepth[1]←0.0;
insabsent[0]←insabsent[1]←true;
end;
begin comment The page builder adds the first node of the contribution list
to the current page, checking to see if it is a decent place to break, and/or
going to ejectpage if the current page is full;
integer q,t;
t←type(pagetail);
case type(contrib) of begin
[hlistnode][vlistnode][rulenode] begin real newht,olddp;
newht←height(contrib); olddp←pagedepth;
pagedepth←depth(contrib);
if pagedepth>pagedepthmax then
begin newht←newht+pagedepth-pagedepthmax;
pagedepth←pagedepthmax;
end;
if emptypage and type(contrib)≠rulenode and newht<pagetopbl then
begin comment Put glue at top of page to adjust first baseline;
integer p,q;
q←interlineglue(pagetopbl-newht,zeroglue);
newht←pagetopbl;
getavail(p);mem[pagetail]←mem[pagetail]+p;
mem[p]←(gluenode lsh typed)+(q lsh valued); pagetail←p;
end;
pageheight←pageheight+olddp+newht;
emptypage←0 end;
[whatsitnode] pageext(contrib);
[gluenode][leadernode] begin integer q;
if emptypage then
begin comment delete glue at beginning of page;
q←contrib; contrib←link(q);
if type(q)=gluenode then delgluelink(value(q)) else dsnodelist(value(q));
freeavail(q); go to addtopage;
end
else begin integer q; case t of begin
[hlistnode][vlistnode][insnode] if testpagebreak(0.0) then
go to ejectpage;
else comment don't try to break at this glue node;
end;
if type(contrib)=gluenode then begin
q←value(contrib) # pointer to glue specification;
pageheight←pageheight+pagedepth+gluespace(q);
pagedepth←0.0;
pagestretch←pagestretch+gluestretch(q);
pageshrink←pageshrink+glueshrink(q);
end end;
end;
[penaltynode] if emptypage then
begin comment delete penalty at beginning of page;
integer q; q←contrib; contrib←link(q); freeavail(q);
go to addtopage;
end
else begin short integer n; n←penalty(contrib);
if n<(1000 min infpen) and testpagebreak(n/100.0) then go to ejectpage;
end;
[ejectnode] if (emptypage<2) or (finaleject and pagehead≠pagetail) then
begin comment Non-null page should be ejected;
if curbreak=0 then curbreak←pagetail # make sure there's a place to break;
if testpagebreak(-2.0) then go to ejectpage else go to ejectpage;
end
else begin t←contrib; contrib←link(t); freeavail(t); go to addtopage;
end;
[insnode] begin integer q; curins←value(contrib);
if mem[curins] land (4 lsh typed) then
begin comment This is a separator node that was cut off a previous page;
q←contrib; contrib←link(q); setlink(q,0); dsnodelist(q);
go to addtopage;
end;
q←type(curins) land 1 # 1=top, 0=bot;
if mem[curins] land (2 lsh typed) and emptypage≠2 then
begin comment This insertion can wait, but see if it fits;
integer newht,newshr;
newht←pageheight+gluespace(curins)+pageinsdepth[q];
newshr←pageshrink+glueshrink(curins);
if insabsent[q] then
begin integer qq; qq←insspecsize*q+separatorspec;
if mem[qq] then
begin comment this insert would also bring in a sep;
newshr←newshr+glueshrink(qq);
newht←newht+gluespace(qq);
if q=0 or emptypage=0 or not insabsent[0] then
newht←newht+insdepth(qq);
end;
end;
if q=0 or not insabsent[0] then newht←newht+pagedepth+pageinsdepth[1]
else if emptypage=0 then newht←newht+pageinsdepth[1];
if newht>pagesize+newshr+0.0001 then
begin mem[waitingtail]←mem[waitingtail]+contrib;
waitingtail←contrib; contrib←link(contrib); setlink(waitingtail,0);
go to addtopage;
end;
end;
if insabsent[q] then
begin integer qq; insabsent[q]←false;
qq←insspecsize*q; if mem[separatorspec+qq] then
begin comment insert the topsep or botsep;
integer pp,pq,pr; getavail(pp); pq←getnode(insspecsize);
pr←boxcopy(value(separatorspec+qq));
mem[pp]←(insnode lsh typed)+(pq lsh valued);
mem[pq+1]←mem[(separatorspec+1)+qq];
mem[pq+2]←mem[(separatorspec+2)+qq];
mem[pq+3]←mem[(separatorspec+3)+qq];
mem[pq+4]←mem[(separatorspec+4)+qq];
mem[pq]←((4+q)lsh typed)+(pr lsh valued);
pageheight←pageheight+gluespace(pq);
pagestretch←pagestretch+gluestretch(pq);
pageshrink←pageshrink+glueshrink(pq);
mem[pagetail]←mem[pagetail]+pp; pagetail←pp;
if q then pageinsdepth[1]←insdepth(separatorspec+insspecsize)
else pageheight←pageheight+insdepth(separatorspec);
end;
end;
pageheight←pageheight+gluespace(curins);
if q=0 then
begin comment This is a botinsert, note that topinsert depths are zero;
pageheight←pageheight+pageinsdepth[0];
pageinsdepth[0]←insdepth(curins);
end;
pagestretch←pagestretch+gluestretch(curins);
pageshrink←pageshrink+glueshrink(curins); if emptypage then emptypage←1 end;
[marknode];
else confusion
end;
mem[pagetail]←mem[pagetail]+contrib # the contribution is contributed;
pagetail←contrib;
contrib←link(contrib); setlink(pagetail,0);
if type(pagetail)=insnode and mem[curins] land (2 lsh typed) and testpagebreak(0.0)
then go to ejectpage else go to addtopage;
end;
ejectpage: comment Now curbreak specifies the best place to break the
current page. We will break it there and ship it off to the output routine;
begin integer t,r;
mem[pagetail]←mem[pagetail]+contrib # temporarily join the lists;
t←link(curbreak); setlink(curbreak,0);
comment Now prune unwanted nodes at the break;
while t do
begin case type(t) of begin
[gluenode] delgluelink(value(t));
[leadernode] dsnodelist(value(t));
[penaltynode];
[ejectnode] begin r←link(t); freeavail(t); t←r; done end;
else done
end;
r←link(t); freeavail(t); t←r;
end;
contrib←t;
if mem[waitinghead] then
begin comment Put waiting inserts back onto contribution list;
mem[waitingtail]←mem[waitingtail]+contrib; contrib←mem[waitinghead];
mem[waitinghead]←0; waitingtail←waitinghead;
end;
if topmark then delrclink(topmark);
topmark←botmark; if botmark then mem[botmark]←mem[botmark]+refct1;
if firstmark then delrclink(firstmark); firstmark←-1;
curbox←vpackage(pagehead,pagesize,true,0) # package the current page;
if firstmark<0 then
begin firstmark←botmark; mem[botmark]←mem[botmark]+refct1;
end;
mem[pagehead]←0; pagetail←pagehead; emptypage←2;
arrblt(savedkount["0"],kount["0"],10);
if tracing land 2 then
begin print(nextline,"Completed for page ",savedkount["0"],":");
tracedump(curbox);
end;
outputdormant←false;
if outputroutine then
begin comment Fire up the output routine;
pushnest; mode←-vmode; prevdepth←pflag;
newsavelevel(outputend);
insrclist(outputroutine);
savedpage←curbox;
go to bigswitch;
end;
go to endpageout;
end;
endoutput: comment The output routine has ended;
if mem[head] then curbox←vpackage(head,0,false,1) else curbox←0;
popnest;
if savedpage then
begin error("\output routine didn't use \page");
dsnodelist(savedpage); savedpage←0;
end;
endpageout: if curbox then
begin comment It's time to send a page to the output medium;
print(" [",savedkount["0"]); firstonpage←true;
shipout(curbox); deadcycles←0;
dsnodelist(curbox);
print("]");
MSTAT print(nextline,"<Memory usage: max ",maxvarused,",",maxdynused,
MSTAT '73&" current ",varused, ",", dynused,">");
end
else deadcycles←deadcycles+1;
outputdormant←true;
go to addtopage;
end;
end